diff --git a/.DS_Store b/.DS_Store deleted file mode 100644 index 199005b..0000000 Binary files a/.DS_Store and /dev/null differ diff --git a/.Rbuildignore b/.Rbuildignore index a6495fa..b097069 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,14 +1,52 @@ ^docs$ -^\\.Rproj\\.user$ ^.*\.Rproj$ ^\.Rproj\.user$ +^\.Renviron$ +^\.Rhistory$ +\.Rhistory$ ^\.claude$ +^\.vscode$ +^\.idea$ + +# Check / build artifacts produced in the source tree. ^splitGraph\.Rcheck$ +^.*\.Rcheck$ ^splitGraph_.*\.tar\.gz$ +^revdep$ +^MD5$ + +# Repository-only material: roadmaps, the JOSS paper, CI, coverage and +# pkgdown configuration, and the developer scripts behind dev/release.md. ^ROADMAP.*\.md$ ^\.github$ ^paper\.md$ ^paper\.bib$ +^paper-figures$ ^codecov\.yml$ ^CODE_OF_CONDUCT\.md$ +^cran-comments\.md$ +^_pkgdown\.yml$ +^_pkgdown\.yml\.bak$ +^\.lintr$ +^dev$ +^pkgdown$ +^pkgdown-site$ + +# Python bytecode. The cache directory sits at +# inst/python/splitspec/__pycache__, so match it at any depth rather than at a +# fixed path: an anchored pattern silently let the .pyc files into the tarball. +__pycache__ +\.pyc$ + +# knitr leftovers from rendering a vignette in place. The vignettes shipped to +# users are built into inst/doc by `R CMD build`, never from here. +^vignettes/figure$ +^vignettes/.*_cache$ +^vignettes/.*_files$ +^vignettes/.*\.html$ +^tests/testthat/Rplots\.pdf$ +^Rplots\.pdf$ + +^\.DS_Store$ +^.*/\.DS_Store$ diff --git a/.claude/settings.local.json b/.claude/settings.local.json deleted file mode 100644 index f6f1631..0000000 --- a/.claude/settings.local.json +++ /dev/null @@ -1,77 +0,0 @@ -{ - "permissions": { - "allow": [ - "Bash(R --version)", - "Bash(Rscript -e 'suppressMessages\\(devtools::test\\(reporter = \"summary\"\\)\\)')", - "Bash(Rscript -e 'suppressMessages\\(devtools::test\\(filter = \"schema-version\", reporter = \"summary\"\\)\\)')", - "Bash(Rscript -e 'suppressMessages\\(devtools::document\\(\\)\\); cat\\(\"---DOC OK---\\\\n\"\\)')", - "Bash(Rscript -e 'suppressMessages\\(devtools::test\\(filter = \"validation-overrides\", reporter = \"summary\"\\)\\)')", - "Bash(Rscript -e 'suppressMessages\\(devtools::test\\(filter = \"deprecations\", reporter = \"summary\"\\)\\)')", - "Bash(Rscript -e 'suppressMessages\\(devtools::test\\(filter = \"query-paths-cap\", reporter = \"summary\"\\)\\)')", - "Bash(Rscript -e 'suppressMessages\\(devtools::test\\(filter = \"prefix-mismatch\", reporter = \"summary\"\\)\\)')", - "Bash(Rscript -e 'suppressMessages\\(devtools::test\\(filter = \"numeric-outcome\", reporter = \"summary\"\\)\\)')", - "Bash(Rscript -e 'res <- as.data.frame\\(suppressMessages\\(devtools::test\\(reporter = \"silent\"\\)\\)\\); cat\\(\"FILES:\", length\\(unique\\(res$file\\)\\), \"\\\\nTESTS:\", sum\\(res$nb\\), \"\\\\nFAIL:\", sum\\(res$failed\\), \"\\\\nWARN:\", sum\\(res$warning\\), \"\\\\nSKIP:\", sum\\(res$skipped\\), \"\\\\n\"\\)')", - "Bash(Rscript -e 'res <- rcmdcheck::rcmdcheck\\(args = c\\(\"--no-manual\"\\), error_on = \"never\", quiet = TRUE\\); cat\\(\"STATUS:\", res$status, \"\\\\nERRORS:\\\\n\"\\); print\\(res$errors\\); cat\\(\"\\\\nWARNINGS:\\\\n\"\\); print\\(res$warnings\\); cat\\(\"\\\\nNOTES:\\\\n\"\\); print\\(res$notes\\)')", - "Bash(Rscript -e 'try\\(pkgbuild::has_build_tools\\(\\)\\); cat\\(\"---\\\\n\"\\); pkg <- pkgload::pkg_install_path\\(\".\"\\); cat\\(\"path:\", pkg, \"\\\\n\"\\)')", - "Bash(R CMD build . --no-manual)", - "Bash(R CMD build . --no-manual --no-build-vignettes)", - "Bash(R CMD check --no-manual --no-vignettes --no-build-vignettes splitGraph_0.2.0.tar.gz)", - "Bash(cp \"C:/Users/Selçuk/Documents/GitHub/splitGraph/vignettes/leakage-aware-workflow.Rmd\" \"C:/Users/Selçuk/Documents/GitHub/splitGraph/inst/doc/leakage-aware-workflow.Rmd\")", - "Bash(Rscript -e 'knitr::purl\\(\"inst/doc/leakage-aware-workflow.Rmd\", output = \"inst/doc/leakage-aware-workflow.R\", quiet = TRUE\\); cat\\(\"OK\\\\n\"\\)')", - "Bash(rm -f splitGraph_0.2.0.tar.gz)", - "Bash(rm -rf splitGraph.Rcheck)", - "Bash(Rscript -e 'suppressMessages\\(devtools::test\\(filter = \"serialization\", reporter = \"summary\"\\)\\)')", - "Bash(Rscript -e 'suppressMessages\\(devtools::load_all\\(\".\", quiet = TRUE\\)\\); knitr::purl\\(\"vignettes/adapter-cookbook.Rmd\", output = tempfile\\(fileext = \".R\"\\), quiet = TRUE\\) -> p; src <- readLines\\(p\\); src <- src[!grepl\\(\"^## ----.*eval=FALSE\", src\\)]; tf <- tempfile\\(fileext = \".R\"\\); writeLines\\(src, tf\\); source\\(tf, echo = FALSE\\); cat\\(\"---VIGNETTE OK---\\\\n\"\\)')", - "Bash(cp \"C:/Users/Selçuk/Documents/GitHub/splitGraph/vignettes/adapter-cookbook.Rmd\" \"C:/Users/Selçuk/Documents/GitHub/splitGraph/inst/doc/adapter-cookbook.Rmd\")", - "Bash(Rscript -e 'knitr::purl\\(\"inst/doc/adapter-cookbook.Rmd\", output = \"inst/doc/adapter-cookbook.R\", quiet = TRUE\\); knitr::purl\\(\"inst/doc/leakage-aware-workflow.Rmd\", output = \"inst/doc/leakage-aware-workflow.R\", quiet = TRUE\\); cat\\(\"OK\\\\n\"\\)')", - "Bash(rm -f splitGraph_*.tar.gz)", - "Bash(Rscript -e 'cat\\(\"rmarkdown::pandoc_available\\(\\):\", rmarkdown::pandoc_available\\(\\), \"\\\\nrmarkdown::pandoc_version\\(\\):\"\\); try\\(print\\(rmarkdown::pandoc_version\\(\\)\\)\\)')", - "Bash(quarto pandoc *)", - "Bash(Rscript -e 'cat\\(\"pandoc:\", rmarkdown::pandoc_available\\(\\), \"\\\\nver:\"\\); print\\(rmarkdown::pandoc_version\\(\\)\\)')", - "Bash(Rscript -e 'suppressMessages\\(devtools::load_all\\(\".\", quiet = TRUE\\)\\); rmarkdown::render\\(\"inst/doc/adapter-cookbook.Rmd\", output_format = \"html_document\", quiet = TRUE\\); cat\\(\"---ADAPTER OK---\\\\n\"\\); rmarkdown::render\\(\"inst/doc/leakage-aware-workflow.Rmd\", output_format = \"html_document\", quiet = TRUE\\); cat\\(\"---LEAKAGE OK---\\\\n\"\\)')", - "Bash(R CMD check --no-manual splitGraph_0.2.0.tar.gz)", - "Bash(Rscript -e 'suppressMessages\\(devtools::load_all\\(\".\", quiet = TRUE\\)\\); rmarkdown::render\\(\"inst/doc/leakage-aware-workflow.Rmd\", output_format = \"html_document\", quiet = TRUE\\); cat\\(\"---LEAKAGE OK---\\\\n\"\\)')", - "Bash(grep -nA 3 \"subject_has_outcome\" R/graph-build-auto.R)", - "Bash(Rscript -e 'tools::.parse_CITATION_file\\(\"inst/CITATION\", meta = packageDescription\\(\"splitGraph\"\\)\\)')", - "Bash(Rscript *)", - "Bash(R -q -e 'if\\(requireNamespace\\(\"testthat\",quietly=TRUE\\)\\){library\\(pkgload\\);load_all\\(\".\",quiet=TRUE\\);testthat::test_dir\\(\"tests/testthat\",reporter=\"summary\",stop_on_failure=FALSE\\)}')", - "Bash(R -q -e 'library\\(pkgload\\);load_all\\(\".\",quiet=TRUE\\);testthat::test_dir\\(\"tests/testthat\",reporter=\"summary\",stop_on_failure=FALSE\\)')", - "Bash(cd /Users/selcuk/Documents/GitHub/splitGraph; which R Rscript; R --version | head -1; echo \"---\"; ls ..; )", - "Bash(R -q -e 'if\\(requireNamespace\\(\"roxygen2\",quietly=TRUE\\)\\){roxygen2::roxygenise\\(\".\"\\)} else {cat\\(\"roxygen2 not installed\\\\n\"\\)}')", - "Bash(R CMD build .)", - "Bash(R CMD check --as-cran splitGraph_0.3.0.9000.tar.gz)", - "Bash(R -q -e 'roxygen2::roxygenise\\(\".\"\\)')", - "Bash(awk '/^create_edges <- function|^create_nodes <- function/{p=1} p{print} /^}/{if\\(p\\)c++; if\\(c>=1 && p\\){}}' R/constructors.R)", - "Bash(tar tzf *)", - "Bash(python3 -c \"import pandas; print\\('pandas', pandas.__version__\\)\")", - "Bash(python3 -c \"import json; print\\('json ok'\\)\")", - "Bash(NOT_CRAN=true R -q -e 'library\\(pkgload\\);load_all\\(\".\",quiet=TRUE\\);testthat::test_file\\(\"tests/testthat/test-python-conformance.R\",reporter=\"summary\"\\)')", - "Bash(R -q -e 'cat\\(requireNamespace\\(\"bioLeak\", quietly=TRUE\\), \"\\\\n\"\\)')", - "Bash(R -q -e ' *)", - "Bash(R -q -e 'library\\(pkgload\\);load_all\\(\".\",quiet=TRUE\\);testthat::test_file\\(\"tests/testthat/test-bioleak-contract.R\",reporter=\"summary\"\\)')", - "Bash(perl -0pi -e 's/expect_s3_class\\\\\\(ls, \"LeakSplits\"\\\\\\)/expect_s4_class\\(ls, \"LeakSplits\"\\)/g' tests/testthat/test-bioleak-contract.R)", - "Bash(NOT_CRAN=true R -q -e 'library\\(pkgload\\);load_all\\(\".\",quiet=TRUE\\);testthat::test_dir\\(\"tests/testthat\",reporter=\"summary\",stop_on_failure=FALSE\\)')", - "Bash(R -q -e 'cat\\(sort\\(grep\\(\"^\\\\\\\\.__\", getNamespaceExports\\(\"bioLeak\"\\), value=TRUE, invert=TRUE\\)\\), sep=\"\\\\n\"\\)')", - "Bash(grep -vE \"^>|^\\\\+|^$\")", - "Bash(R -q -e 'suppressMessages\\(library\\(pkgload\\)\\);load_all\\(\".\",quiet=TRUE\\); print\\(head\\(formals\\(derive_split_constraints\\)$mode\\)\\)')", - "Bash(grep -nE \"^#{2,3} \" vignettes/leakage-aware-workflow.Rmd)", - "Bash(grep -cE '^```\\\\{r' vignettes/leakage-aware-workflow.Rmd)", - "Bash(tar tzvf *)", - "Bash(awk '$0 ~ /inst\\\\/doc/ {sum+=$3} END {printf \"inst/doc total: %.2f MB\\\\n\", sum/1048576}')", - "Bash(awk '{printf \"%.0f KB %s\\\\n\", $3/1024, $6}')", - "Bash(R CMD check --as-cran splitGraph_0.3.0.tar.gz)", - "Bash(awk '{print $5\" \"$9}')", - "Bash(grep -nE '```\\\\{python' vignettes/cross-language-handoff.Rmd)", - "Bash(grep -cE '^```python$' vignettes/cross-language-handoff.Rmd)", - "Bash(R -q -e 'cat\\(requireNamespace\\(\"reticulate\", quietly=TRUE\\),\"\\\\n\"\\)')", - "Bash(grep -rnE '```\\\\{python' vignettes/)", - "Bash(NOT_CRAN=true R -q -e ' *)", - "Bash(R -q -e 'suppressMessages\\(library\\(pkgload\\)\\);load_all\\(\".\",quiet=TRUE\\);testthat::test_file\\(\"tests/testthat/test-split-spec.R\",reporter=\"summary\"\\)')", - "Bash(NOT_CRAN=true R -q -e 'suppressMessages\\(library\\(pkgload\\)\\);load_all\\(\".\",quiet=TRUE\\);testthat::test_dir\\(\"tests/testthat\",reporter=\"summary\",stop_on_failure=FALSE\\)')", - "Bash(R -q -e 'ap <- tryCatch\\(available.packages\\(repos=\"https://cloud.r-project.org\"\\), error=function\\(e\\) NULL\\); if\\(is.null\\(ap\\)\\) cat\\(\"no network to check CRAN\\\\n\"\\) else cat\\(\"bioLeak on CRAN:\", \"bioLeak\" %in% rownames\\(ap\\), \"\\\\n\"\\)')", - "Bash(git checkout *)", - "Bash(awk '/^---$/{c++;next} c>=2 && !/^# References/{print}' paper.md)", - "Bash(R CMD check splitGraph_0.3.0.tar.gz)" - ] - } -} diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index d5516e1..e932f0d 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -28,10 +28,21 @@ jobs: env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} R_KEEP_PKG_SOURCE: yes + # Neither check-r-package nor rcmdcheck sets NOT_CRAN, so without this + # every skip_on_cran() test (the Python conformance check, the + # performance budget) would be skipped in CI too. + NOT_CRAN: true + # The performance budget has its own Linux-only workflow; skip it here so + # slow shared Windows/macOS runners cannot fail the check with noise. + SPLITGRAPH_SKIP_PERF: true steps: - uses: actions/checkout@v4 + - uses: actions/setup-python@v5 + with: + python-version: "3.x" + - uses: r-lib/actions/setup-pandoc@v2 - uses: r-lib/actions/setup-r@v2 diff --git a/.github/workflows/perf-budget.yaml b/.github/workflows/perf-budget.yaml new file mode 100644 index 0000000..50d8792 --- /dev/null +++ b/.github/workflows/perf-budget.yaml @@ -0,0 +1,37 @@ +# Wall-clock budget guard for the core pipeline (tests/testthat/test-performance.R). +# Runs on Linux only: the budgets are generous, but a shared Windows/macOS runner +# can be slow enough to produce noise, and the point is to catch a return to +# superlinear behaviour, not to benchmark. +on: + push: + branches: [main, master] + pull_request: + branches: [main, master] + +name: perf-budget + +permissions: read-all + +jobs: + perf-budget: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + NOT_CRAN: true + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::testthat, any::pkgload + + - name: Run the performance budget tests + run: | + Rscript -e 'pkgload::load_all(".", quiet = TRUE); testthat::test_file("tests/testthat/test-performance.R", reporter = "progress", stop_on_failure = TRUE)' + + - name: Print the benchmark table + run: Rscript inst/bench/pipeline.R 500 2000 5000 diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml new file mode 100644 index 0000000..561657f --- /dev/null +++ b/.github/workflows/pkgdown.yaml @@ -0,0 +1,53 @@ +# Build the pkgdown site and publish it to GitHub Pages. The DESCRIPTION `URL` +# field advertises https://selcukorkmaz.github.io/splitGraph/, so this workflow +# has to run at least once (and Pages has to be enabled for the repository) +# before a CRAN submission, or `R CMD check --as-cran` reports that URL as a +# 404 NOTE. +on: + push: + branches: [main, master] + pull_request: + branches: [main, master] + release: + types: [published] + workflow_dispatch: + +name: pkgdown + +permissions: read-all + +jobs: + pkgdown: + runs-on: ubuntu-latest + # Only restrict concurrency for non-PR jobs + concurrency: + group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + permissions: + contents: write + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::pkgdown, local::. + needs: website + + - name: Build site + run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) + shell: Rscript {0} + + - name: Deploy to GitHub pages + if: github.event_name != 'pull_request' + uses: JamesIves/github-pages-deploy-action@v4.5.0 + with: + clean: false + branch: gh-pages + folder: pkgdown-site diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 76c82a6..1c9adec 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -14,10 +14,18 @@ jobs: runs-on: ubuntu-latest env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + # covr does not set NOT_CRAN either; without it the Python conformance + # test is skipped and its lines are never counted. + NOT_CRAN: true + SPLITGRAPH_SKIP_PERF: true steps: - uses: actions/checkout@v4 + - uses: actions/setup-python@v5 + with: + python-version: "3.x" + - uses: r-lib/actions/setup-r@v2 with: use-public-rspm: true diff --git a/.gitignore b/.gitignore index 5b6a065..1e8b686 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,36 @@ +# R session state .Rproj.user .Rhistory .RData .Ruserdata +.Renviron + +# Build and check artifacts produced in the source tree by `R CMD build` / +# `R CMD check` / revdepcheck. None of these belong in the repository. +*.tar.gz +*.Rcheck/ +revdep/ + +# Generated by `R CMD build --md5` (as CRAN does) inside the tarball; never part of the source tree. +MD5 + +# Rendered pkgdown site (the workflow deploys it to the gh-pages branch). +pkgdown-site/ + +# knitr leftovers from rendering a vignette in place; the shipped copies are +# built into inst/doc by `R CMD build`. +vignettes/figure/ +vignettes/*_cache/ +vignettes/*_files/ +vignettes/*.html +Rplots.pdf + +# Python bytecode from running the shipped splitspec reader. +__pycache__/ +*.pyc + +# Claude Code's machine-local permission allowlist. A shared `.claude/settings.json` +# would still be committable; this one is per-machine. +.claude/settings.local.json + +.DS_Store diff --git a/.lintr b/.lintr new file mode 100644 index 0000000..4216880 --- /dev/null +++ b/.lintr @@ -0,0 +1,14 @@ +linters: linters_with_defaults( + line_length_linter(160), # signature-heavy R; 8 offenders were rewrapped, this is now a real gate + object_name_linter = NULL, # `.depgraph_*` internal prefix and S3 method names + object_length_linter = NULL, # the same prefix pushes internal names past 30 characters by design + commented_code_linter = NULL, + indentation_linter = NULL, # roxygen-heavy files trip this on continuation lines + object_usage_linter = NULL # false positives on data.frame column names in `[` + ) +exclusions: list( + "inst/bench", + "docs", + "tests/testthat/_snaps" + ) +encoding: "UTF-8" diff --git a/DESCRIPTION b/DESCRIPTION index d122304..635f29c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: splitGraph Title: Dataset Dependency Graphs for Leakage-Aware Evaluation -Version: 0.3.0 +Version: 0.4.0 Authors@R: c( person("Selcuk", "Korkmaz", role = c("aut","cre"), email = "selcukorkmaz@gmail.com", comment = c(ORCID = "0000-0003-4632-6850")) @@ -17,8 +17,10 @@ BugReports: https://github.com/selcukorkmaz/splitGraph/issues Encoding: UTF-8 Depends: R (>= 4.1.0) Imports: graphics, igraph, stats, utils -Suggests: bioLeak, jsonlite, knitr, pkgload, rmarkdown, testthat (>= 3.0.0) +Suggests: bioLeak, jsonlite, knitr, pkgload, rmarkdown, rsample, + SummarizedExperiment, testthat (>= 3.0.0) VignetteBuilder: knitr Config/testthat/edition: 3 +Config/Needs/website: selcukorkmaz/leakdown NeedsCompilation: no RoxygenNote: 7.3.3 diff --git a/MD5 b/MD5 deleted file mode 100644 index 5bab4b7..0000000 --- a/MD5 +++ /dev/null @@ -1,42 +0,0 @@ -96eb767f235ee83814a84ea8d90ea251 *DESCRIPTION -6ad945f2130b4653d9354e02de053c72 *LICENSE -849c5981bf3a1ace4623c70fe18149e8 *NAMESPACE -4aa6ee5b255a6528a244be1cda3c07fd *NEWS.md -315c25f7dbab0a61e45654770bd88e18 *R/constraints.R -321059040b75bf41df98dcce8dc4ce1b *R/constructors.R -7328692e9e2366eb967137ee4e369983 *R/graph-build-auto.R -b3a27323d82c58322f5dae14c525bc66 *R/graph-build.R -bc1fc91da4af38bc1969b30cba1d35df *R/ingest.R -0f79bb8b1020d1f5ccc359817d75426f *R/methods.R -a48eccd0b68cf65109e6d9806ccf822e *R/query.R -f25af99ba215e71cd899dcdc0285992b *R/split-spec.R -d38d6a15da2f089a6f574c72c40550e0 *R/splitGraph-package.R -2ee66f785b758bdd4a23c3ea6826de1d *R/validate.R -5c41d91c1212e16f1e535bbab71a258e *README.md -903396fe6ca1312961ff175e5f4b0471 *build/vignette.rds -a8acda8977ffd6c08ca389e942031e35 *inst/CITATION -83ce381cd188c7fb8e29a46879d23e8e *inst/doc/leakage-aware-workflow.R -9545ffa267f5e0c51cbe2e41add20e47 *inst/doc/leakage-aware-workflow.Rmd -5d16ec17cc34d77671f9a370e25482d4 *inst/doc/leakage-aware-workflow.html -aa4ed89c3322513fc94ad1fbf47f8e37 *inst/extdata/demo_metadata.csv -0e4f54cdf765821e57af0a7cc5f56e21 *man/as_split_spec.Rd -c822b7c921e98beb3a21b7243db6b5ea *man/build_dependency_graph.Rd -b32c1af679111d018c185dcd8235f79c *man/create_nodes.Rd -94c6e1c33cf7c51df12c1a7836d8fb3e *man/depgraph_validation_report.Rd -3cad11b500a28d0b04d74dd098ce8aa6 *man/derive_split_constraints.Rd -675f4412ce9a5b4aa4a771624f359c83 *man/figures/README-plot-1.png -fc1ce15928af9517fff4df43e2c60263 *man/graph_from_metadata.Rd -6c6e7d8b0a52c40b8f0c3ec9c457553b *man/graph_node_set.Rd -ec619ad64f65def10729f03c51f13e76 *man/ingest_metadata.Rd -0d9e2d0d8dbf8bb28b292c5ed939a108 *man/query_node_type.Rd -1e2bba778b8542d9f15b1b07bbc89626 *man/splitGraph-package.Rd -2e8623e9ccb8aeba4e39418993581471 *tests/testthat.R -45520fb265dd8fd3fc26666dd4630f51 *tests/testthat/test-constraints.R -95114d013be1128d83f0a7c9cc7395a4 *tests/testthat/test-constructors.R -c8e0ad6ae7635d17edd9891283713348 *tests/testthat/test-graph-from-metadata.R -56f5481d771a2fce094d8f1e30bda2bf *tests/testthat/test-methods.R -3d4d81f903d8c3593a7e96dbff24a318 *tests/testthat/test-query.R -aec791998ed828ab2c634864c6d4e98a *tests/testthat/test-split-spec.R -7bed74f37f6d27def28c7c26e19fcb0c *tests/testthat/test-validate.R -cae59aa294146ab84c8c6f70b03fe61e *tests/testthat/test-validation-report.R -9545ffa267f5e0c51cbe2e41add20e47 *vignettes/leakage-aware-workflow.Rmd diff --git a/NAMESPACE b/NAMESPACE index c96f638..7f135fd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,5 @@ # Generated by roxygen2: do not edit by hand -S3method(as.data.frame,dependency_constraint) S3method(as.data.frame,depgraph_validation_report) S3method(as.data.frame,graph_edge_set) S3method(as.data.frame,graph_node_set) @@ -9,8 +8,10 @@ S3method(as.data.frame,leakage_risk_summary) S3method(as.data.frame,split_constraint) S3method(as.data.frame,split_spec) S3method(as.data.frame,split_spec_validation) +S3method(graph_from_metadata,SummarizedExperiment) +S3method(graph_from_metadata,data.frame) +S3method(graph_from_metadata,default) S3method(plot,dependency_graph) -S3method(print,dependency_constraint) S3method(print,dependency_graph) S3method(print,depgraph_validation_report) S3method(print,graph_edge_set) @@ -21,7 +22,6 @@ S3method(print,split_constraint) S3method(print,split_spec) S3method(print,split_spec_validation) S3method(print,splitgraph_json_report) -S3method(summary,dependency_constraint) S3method(summary,dependency_graph) S3method(summary,depgraph_validation_report) S3method(summary,graph_edge_set) @@ -31,18 +31,19 @@ S3method(summary,leakage_risk_summary) S3method(summary,split_constraint) S3method(summary,split_spec) S3method(summary,split_spec_validation) +export(add_edges) export(as_igraph) export(as_split_spec) export(build_dependency_graph) -export(build_depgraph) +export(combine_graphs) export(create_edges) export(create_nodes) -export(dependency_constraint) export(dependency_graph) export(depgraph_validation_report) export(derive_split_constraints) export(detect_dependency_components) export(detect_shared_dependencies) +export(export_graph) export(graph_edge_set) export(graph_from_metadata) export(graph_node_set) @@ -52,9 +53,6 @@ export(ingest_metadata) export(leakage_risk_summary) export(migrate_dependency_graph_json) export(migrate_split_spec_json) -export(new_depgraph) -export(new_depgraph_edges) -export(new_depgraph_nodes) export(query_edge_type) export(query_neighbors) export(query_node_type) @@ -67,8 +65,8 @@ export(spatial_edges_from_coords) export(split_constraint) export(split_spec) export(split_spec_validation) +export(subset_graph) export(summarize_leakage_risks) -export(validate_depgraph) export(validate_graph) export(validate_graph_json) export(validate_split_spec) diff --git a/NEWS.md b/NEWS.md index 8579be2..6267264 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,269 @@ +# splitGraph 0.4.0 + +## Fixes made during CRAN submission + +- `export_graph(format = "gml")` now passes explicit node ids to igraph's GML + writer. Leaving igraph's `id` argument at its `NULL` default made newer + igraph versions hand a zero-length vector to the C layer, which rejected it + with "Size of id vector must match vertex count"; the failure appeared on + CRAN's R-devel machines while passing locally on igraph 2.2.1. +- The README's links to `CONTRIBUTING.md` and `CODE_OF_CONDUCT.md` are now + absolute GitHub URLs. Both files are build-ignored, so the relative links + dangled inside the installed package. + +A deliberate **breaking release** (see "Breaking changes" below); everything +after it is intended to be additive. The theme is maturity: every step of the +pipeline is now linear in the size of the dataset, the `split_spec` contract is +self-contained and schema-checked, the 0.1-era API debt is gone, and what each +downstream consumer actually accepts is documented and pinned by tests. + +## Performance + +Every step of the pipeline is now linear in the number of nodes and edges, and +the derivation results, validation issues, and written JSON are byte-identical +to 0.3.0 on regression cohorts. + +- **Composite and pairwise grouping no longer enumerate sample pairs.** + `derive_split_constraints(mode = "composite")`, `mode = "relatedness"`, + `mode = "spatial"`, and `detect_dependency_components()` compute connected + components on the bipartite sample-target graph. With the default `via` + (subject, batch, study, time) composite derivation of 500 samples took about + 70 s and grew quadratically (about 3.5 min at 750 samples); it now takes + under 0.1 s at 5 000 samples and about 0.2 s at 20 000. +- **Direct assignments, sample maps, and rule-based composites are vectorised** + (one `data.frame()` per table instead of one per sample). + `as_split_spec(constraint, graph = g)` dropped from 27 s to about 0.3 s at + 5 000 samples. +- **Validation builds its issue table once** instead of `rbind`-ing one-row + frames, checks edge signatures with a single join against the schema, and + replaces `stats::aggregate()` with `split()`-based counting: 7 s to under 1 s + at 5 000 samples. +- **JSON writers hand jsonlite data frames** instead of nested per-row lists, + and `spatial_edges_from_coords()` scans the distance matrix with `which()` + instead of a double loop. +- `create_nodes()` detects conflicting duplicate definitions in one pass over + the distinct rows rather than one table scan per duplicated identifier. +- New `inst/bench/pipeline.R` reproduces the timings, and + `tests/testthat/test-performance.R` (skipped on CRAN) fails if any step + exceeds a generous wall-clock budget or composite derivation stops scaling + linearly. + +## New features + +**`split_spec` contract (schema 0.3.0)** + +- **Stratum annotation.** `as_split_spec(constraint, graph = g)` fills a new + `stratum` column with the key of the single `Outcome` node attached to each + sample (`sample_has_outcome`, falling back to the subject's single outcome via + `subject_has_outcome`) and declares it through `stratum_var`. It is an + annotation of the outcome level, exposed so consumers such as scikit-learn's + `StratifiedGroupKFold` can stratify; splitGraph still never balances folds. + `validate_split_spec()` checks the declared column (`invalid_stratum_var`, + `empty_stratum_var`, `partial_stratum`). The Python reader gains + `stratum_var`, a default for `strata()`, and `stratified_group_kfold()`; the + conformance test compares strata as well as grouping and ordering. +- **Pairwise sources inside composite derivations.** `via` for + `mode = "composite"` now accepts `"relatedness"` and `"spatial"` (or their + relation names) alongside the direct sources. In the strict strategy their + thresholded edges join the same connected-component search; in the + rule-based strategy they contribute the component label, and a singleton + component counts as no assignment so the sample falls through to the next + mode. `metadata$via` lists node types for direct sources and mode names for + pairwise ones. +- **Provenance.** `relatedness_edges_from_kinship()` and + `spatial_edges_from_coords()` record their threshold and metric on the edge + set's `source`; `build_dependency_graph()` carries every edge set's source + into `metadata$edge_sources` (also serialised); pairwise constraints report + `metadata$threshold` / `threshold_metric`; and `as_split_spec()` adds `via`, + `priority`, `threshold`, `threshold_metric`, and `igraph_version` to the spec + metadata. +- **Schema 0.3.0, versioned.** `schema_version` moves to `"0.3.0"` (same major: + `0.1.0` and `0.2.0` files still load silently) and the shipped schemas now + live under `inst/schema//`, so a file's `$schema` URL stays valid + after later bumps. `migrate_split_spec_json()` fills `stratum` with `NA`. +- **Validating readers.** `read_dependency_graph(path, validate = TRUE)` and + `read_split_spec(path, validate = TRUE)` check the file against the shipped + schema before parsing and run `validate_graph()` / `validate_split_spec()` + on the result, failing with a classed error. The R-side JSON validators + themselves now check that `attrs` is an object, that `sample_data` columns + have the declared types, and that vector-valued metadata fields are arrays. +- **New leakage rule `subject_cross_site_overlap`** (warning): a subject with + samples collected at several sites, mirroring `subject_cross_study_overlap`; + `summarize_leakage_risks()` reports it as severed by subject or site + grouping. + +**Graph editing and export** + +- `subset_graph(g, samples)`, `combine_graphs(g1, g2, ...)`, and + `add_edges(g, edge_set)` derive new, validated graphs from existing ones + without rebuilding from node/edge sets. Subsetting has the same semantics as + `derive_split_constraints(samples = )`; combining regenerates edge ids and + rejects conflicting definitions; adding edges preserves existing ids. +- `export_graph(g, file, format)` writes GraphML, GML, or node/edge CSV + tables for Cytoscape, Gephi, networkx, and `igraph::read_graph()`, with the + `attrs` list-column flattened to `attr_` scalar columns. +- `plot(g, focus = "sample_projection")` draws the sample graph implied by the + chosen `via` relations, and `plot(g, focus = "ego", node = )` draws one + node's neighbourhood. The plot method is now documented (`?plot.dependency_graph`). + +**Input and consumers** + +- `graph_from_metadata()` is now an S3 generic with a `SummarizedExperiment` + method (Bioconductor's \pkg{SummarizedExperiment} in Suggests): `colData()` is + used as the metadata table and the assay column names become `sample_id` + when no such column exists (`sample_id_col =` overrides). +- The adapter-cookbook vignette's `rsample` adapters are now executed when + `rsample` is installed (it is in Suggests); the base-R adapter was already + executed. +- `?as_split_spec` and the README gain a "What downstream consumers read" + table, verified by running against bioLeak 0.3.8. The contract test now pins + every row: bioLeak accepts exactly the subject / batch / study / time modes; + it errors on site, region, platform, assay, relatedness and spatial (absent + from its mode map) and also on composite (mapped to a `make_split_plan()` + mode whose required arguments the adapter never supplies); and the + documented workaround, joining `group_id` onto the observation frame and + calling `make_split_plan()` directly, works. A bioLeak release that fixes + either limitation will surface as a deliberate test failure to flip. +- The stale comment naming fastml as a consumer was removed; fastml has no + splitGraph adapter. +- `inst/python/pyproject.toml` packages the Python reader as `splitspec` + (stdlib-only, optional `pandas` / `sklearn` extras) for a PyPI release. + +**Quality infrastructure and documentation** + +- CI sets `NOT_CRAN=true`, installs Python, and so runs the Python + conformance test in both the check and coverage workflows for the first + time; a new Linux-only `perf-budget` workflow runs the performance tests. +- `dev/coverage.R` runs covr locally with a 90 % threshold; `dev/release.md` + is the release checklist (schema bump rules, line-ending check for Windows + builds, reverse-dependency check against bioLeak); `.lintr` and + `_pkgdown.yml` (grouped reference index) are committed. +- New vignettes: **quick-start** (metadata frame to JSON `split_spec` with a + mode decision table), **faq-design-notes** (why not `make_split_plan()` + directly, composite over-merging, thresholds and transitive closure, the + stratum annotation, schema versioning, conditions), and + **case-study-gse60424** (a real public cohort: GEO series GSE60424, cached + as `inst/extdata/GSE60424_samples.csv`). + +**Conditions** + +- **Classed conditions.** Every error raised by splitGraph now inherits from + `splitgraph_error` — including every invalid enumerated argument (`mode`, + `strategy`, `format`, `focus`, `layout`, `direction`, `outcome_scope`), which + previously produced a bare `match.arg()` error; partial matching is + unchanged. Each condition carries a `code` field, `NA` for plain argument + checks; the documented + subclasses are `splitgraph_schema_error`, `splitgraph_reference_error`, + `splitgraph_ambiguity_error`, `splitgraph_validation_error`, and + `splitgraph_io_error`. Package warnings carry `splitgraph_warning`. See + `?splitgraph_conditions`. Messages are unchanged, so code matching on text + keeps working. +- `relatedness_edges_from_kinship()` accepts a square kinship / GRM **matrix** + with subject ids as row names (e.g. PLINK `--make-rel square` output) in + addition to the long pair table. + +## Bug fixes + +- **Factor / numeric `site_id`, `region_id`, `platform_id` columns.** + `graph_from_metadata()` failed with an `nzchar()` error when any of the three + identifier columns introduced in 0.3.0 was a factor, because + `ingest_metadata()` did not coerce them to character alongside the older + identifier columns. All identifier columns are now coerced, and + `create_nodes()` coerces its `id_col` defensively so factor identifiers work + on the manual constructor path too. +- **`as_split_spec(constraint, graph = ...)` no longer aborts on ambiguous + annotations.** Graph enrichment fills the blocking / ordering columns + (`batch_group`, `study_group`, `site_group`, ..., `order_rank`) on a + best-effort basis. A source that cannot be resolved unambiguously (for + example a sample linked to two batches on a graph built with + `validate = FALSE`) is now left as `NA` and reported in + `metadata$enrichment_warnings` (also appended to `metadata$warnings`) + instead of raising an error unrelated to the requested constraint mode. +- **Consistent `severed` column.** `summarize_leakage_risks()` and the + `leakage_risk_summary()` constructor now include the `severed` column in the + empty diagnostics table, matching the populated case. +- **Vector metadata fields are always JSON arrays.** `write_split_spec()` used + `auto_unbox`, so a single-element `relations_used`, `warnings`, or + `enrichment_warnings` was written as a bare string although the shipped schema + declares `relations_used` an array. These fields are now written as arrays + regardless of length; `read_split_spec()` already coerced them back to character + vectors, so existing files still load. +- **Empty JSON objects are written as `{}`, not `[]`.** An empty + `metadata$validation_overrides` (every graph built with default arguments), + an empty `edge_sources`, and the metadata of a hand-built `split_spec()` were + serialised as empty *arrays*, which the shipped schemas reject since they + declare objects. The R-side validators now distinguish the two cases — an + empty JSON object and an empty array both parse to a zero-length list, but + only the object carries names — and check `attrs`, `metadata`, + `validation_overrides` and `edge_sources`, so `read_*(validate = TRUE)` and + `validate_graph_json()` catch the malformed shape. Nothing the package can + write now fails its own validator, including edgeless graphs and specs with + no metadata. +- **`add_edges()` accepts an edge set with no edges.** The thresholded helpers + return an empty `graph_edge_set` when no pair passes, which previously + crashed `add_edges()` with an unclassed error. The graph is now returned + unchanged, with the threshold still recorded in `metadata$edge_sources`. +- **`build_dependency_graph()` rejects an unnamed `validation_overrides` + list.** Overrides are looked up by name, so an unnamed list silently did + nothing (and serialised as a JSON array). +- **Pairwise `threshold` / `threshold_metric` round-trip.** They are written as + `null` for non-pairwise specs and now read back as typed `NA` rather than + `NULL`, so a spec's metadata survives a write/read cycle unchanged. +- **An ambiguous sample-level outcome no longer borrows the subject's.** A + sample linked to several `Outcome` nodes has no unique stratum and stays + `NA`, instead of falling through to the `subject_has_outcome` label. + +## Breaking changes + +- **Removed the 0.1-era aliases deprecated in 0.2.0.** Migration: + + | Removed | Use instead | + |---|---| + | `new_depgraph_nodes()` | `graph_node_set()` | + | `new_depgraph_edges()` | `graph_edge_set()` | + | `new_depgraph()` | `dependency_graph()` | + | `build_depgraph()` | `build_dependency_graph()` | + | `validate_depgraph()` | `validate_graph()` | + | `validate_graph(checks = ...)` | `validate_graph(levels = ..., severities = ...)` | + + Calling a removed alias is now a "could not find function" error; passing + `checks=` is an "unused argument" error. +- **Composite and pairwise constraints no longer carry `metadata$projection_edges`.** + The explicit sample-pair table was the quadratic part of the old derivation + and is not needed for grouping. `metadata$n_dependency_edges` (the number of + sample-target edges the components were computed from) replaces it; the pair + table itself is still available from + `detect_dependency_components()$metadata$projection_edges` and + `detect_shared_dependencies()` when it is wanted. +- **Removed the unused `dependency_constraint()` constructor** and its + `print` / `summary` / `as.data.frame` methods. Like the `leakage_constraint()` + removed in 0.3.0, the class was exported but never produced or consumed + anywhere in the package; `split_constraint()` (produced by + `derive_split_constraints()`) is the supported constraint type. + +## Documentation + +- `?read_dependency_graph` no longer claims to return a *validated* graph: the + reader checks table / `igraph` consistency but does not re-run + `validate_graph()`, so a file written with `validate = FALSE` loads without + error. Call `validate_graph()` on files from untrusted or older sources. +- `?graph_from_metadata` now lists `site_id`, `region_id`, and `platform_id` + among the auto-detected columns and states that identifier columns may be + character, factor, or numeric. +- `?derive_split_constraints` documents how composite `via` combines direct + and pairwise sources (the restriction to direct sources noted early in this + cycle was lifted; see "Pairwise sources inside composite derivations" above). + +## Infrastructure + +- The Python conformance test falls back to a `python` executable when + `python3` is absent (the usual situation on Windows), provided it reports + itself as Python 3. +- The stale `MD5` file was removed from the source tree. It is a build artefact + that `R CMD build --md5` (the flag CRAN applies when it builds a submission) + writes inside the tarball; a plain `R CMD build` does not create it, and it never + belongs in the source tree. + # splitGraph 0.3.0 This release broadens the vocabulary of leakage relations splitGraph can model, @@ -9,7 +275,7 @@ remain the responsibility of downstream consumers such as **bioLeak**. ## New features -### New leakage relations +**New leakage relations** - **`Site` node type and `sample_collected_at_site` edge.** Multi-site / multi-center structure is now a first-class typed relation. @@ -51,7 +317,7 @@ remain the responsibility of downstream consumers such as **bioLeak**. modes honor the `samples=` subset (components are recomputed within the subset, so an excluded bridge sample cannot leak structure across the split). -### Interchange-format hardening +**Interchange-format hardening** - **Formal JSON Schema.** The `dependency_graph` and `split_spec` on-disk formats now have formal JSON Schemas (Draft 2020-12) shipped in `inst/schema/`, and @@ -71,7 +337,7 @@ remain the responsibility of downstream consumers such as **bioLeak**. (`splitgraph_version`, `derived_at`) alongside the existing `source_mode` / `source_strategy` / `relations_used`. -### Cross-language interoperability +**Cross-language interoperability** - **Python reference consumer.** A pure-Python reader (`inst/python/splitspec/`) parses the `split_spec` JSON and exposes the grouping, ordering, and stratum diff --git a/R/constraints.R b/R/constraints.R index b7688c3..70a7f3e 100644 --- a/R/constraints.R +++ b/R/constraints.R @@ -22,22 +22,48 @@ assay = "sample_measured_by_assay" ) +# Every mode `derive_split_constraints()` accepts, in the order they appear in +# its `mode` default. Single source of truth for the formal default, the +# argument check, and the classed-error choices. +.depgraph_constraint_modes <- c( + "subject", "batch", "study", "time", "site", "region", + "platform", "assay", "relatedness", "spatial", "composite" +) + .depgraph_normalize_constraint_mode <- function(mode) { mode <- tolower(as.character(mode)[1L]) - .depgraph_assert(mode %in% c("subject", "batch", "study", "time", "site", "region", "platform", "assay", "relatedness", "spatial", "composite"), paste0("Unsupported constraint mode: ", mode)) + .depgraph_assert( + mode %in% .depgraph_constraint_modes, + paste0("Unsupported constraint mode: ", mode) + ) mode } +# Modes that may be combined inside a composite derivation: every direct +# (single-target) mode plus the pairwise modes. +.depgraph_composable_modes <- function() { + c(names(.depgraph_constraint_mode_map), names(.depgraph_pairwise_relation)) +} + +.depgraph_is_pairwise_mode <- function(mode) { + mode %in% names(.depgraph_pairwise_relation) +} + .depgraph_normalize_constraint_modes <- function(modes) { modes <- unique(tolower(as.character(modes))) .depgraph_assert(length(modes) > 0L, "At least one constraint mode is required.") - .depgraph_assert(all(modes %in% names(.depgraph_constraint_mode_map)), paste0( + .depgraph_assert(all(modes %in% .depgraph_composable_modes()), paste0( "Unsupported constraint mode(s): ", - paste(setdiff(modes, names(.depgraph_constraint_mode_map)), collapse = ", ") + paste(setdiff(modes, .depgraph_composable_modes()), collapse = ", ") )) modes } +# Relation (edge type) that a composable mode contributes. +.depgraph_mode_relation <- function(mode) { + if (.depgraph_is_pairwise_mode(mode)) .depgraph_pairwise_relation[[mode]] else .depgraph_constraint_edge_map[[mode]] +} + .depgraph_constraint_samples <- function(graph, samples = NULL) { sample_ids <- .depgraph_resolve_sample_node_ids(graph, samples) sample_nodes <- graph$nodes$data[graph$nodes$data$node_type == "Sample", , drop = FALSE] @@ -72,13 +98,14 @@ } else { "" } - stop( + .depgraph_stop( paste0( "Multiple ", mode, " assignments found for sample(s): ", paste(duplicate_samples, collapse = ", "), hint ), - call. = FALSE + class = "splitgraph_ambiguity_error", + code = paste0("sample_multiple_", mode, "_assignments") ) } multi_assignment_samples <- duplicate_samples @@ -88,40 +115,20 @@ edges <- edges[!duplicated(edges$from), , drop = FALSE] - target_rows <- node_data[node_data$node_id %in% edges$to, c("node_id", "node_key", "label", "attrs"), drop = FALSE] - target_map <- stats::setNames(split(target_rows, target_rows$node_id), names(split(target_rows, target_rows$node_id))) - - rows <- lapply(seq_len(nrow(sample_nodes)), function(i) { - sample_row <- sample_nodes[i, , drop = FALSE] - edge_row <- edges[edges$from == sample_row$node_id, , drop = FALSE] - - if (nrow(edge_row) == 0L) { - return(data.frame( - sample_id = sample_row$node_key, - sample_node_id = sample_row$node_id, - linked_node_id = NA_character_, - linked_node_type = target_type, - linked_key = NA_character_, - linked_label = NA_character_, - edge_type = edge_type, - stringsAsFactors = FALSE - )) - } - - target_row <- target_map[[edge_row$to[[1L]]]] - data.frame( - sample_id = sample_row$node_key, - sample_node_id = sample_row$node_id, - linked_node_id = target_row$node_id[[1L]], - linked_node_type = target_type, - linked_key = target_row$node_key[[1L]], - linked_label = target_row$label[[1L]], - edge_type = edge_row$edge_type[[1L]], - stringsAsFactors = FALSE - ) - }) - - out <- do.call(rbind, rows) + # Vectorised lookup: one edge per sample at most, then one node row per edge. + edge_idx <- match(sample_nodes$node_id, edges$from) + target_idx <- match(edges$to[edge_idx], node_data$node_id) + + out <- data.frame( + sample_id = sample_nodes$node_key, + sample_node_id = sample_nodes$node_id, + linked_node_id = node_data$node_id[target_idx], + linked_node_type = target_type, + linked_key = node_data$node_key[target_idx], + linked_label = node_data$label[target_idx], + edge_type = edge_type, + stringsAsFactors = FALSE + ) row.names(out) <- NULL attr(out, "multi_assignment_samples") <- multi_assignment_samples out @@ -141,40 +148,28 @@ .depgraph_build_sample_map <- function(assignments, mode, explanation_prefix = NULL) { mode <- .depgraph_normalize_constraint_mode(mode) - - rows <- lapply(seq_len(nrow(assignments)), function(i) { - row <- assignments[i, , drop = FALSE] - linked <- !is.na(row$linked_node_id[[1L]]) && nzchar(row$linked_node_id[[1L]]) - group_id <- if (linked) { - paste0(mode, ":", row$linked_key[[1L]]) - } else { - paste0(mode, ":unlinked:", row$sample_id[[1L]]) - } - group_label <- if (linked) row$linked_key[[1L]] else paste0("unlinked_", row$sample_id[[1L]]) - explanation <- if (linked) { - paste0( - explanation_prefix %||% paste0("Grouped by ", mode), - " through ", row$edge_type[[1L]], - " -> ", row$linked_key[[1L]], "." - ) - } else { - paste0( - "No ", mode, " assignment was available; sample retained as an unlinked singleton group." - ) - } - - data.frame( - sample_id = row$sample_id, - sample_node_id = row$sample_node_id, - group_id = group_id, - constraint_type = mode, - group_label = group_label, - explanation = explanation, - stringsAsFactors = FALSE - ) - }) - - out <- do.call(rbind, rows) + prefix <- explanation_prefix %||% paste0("Grouped by ", mode) + + linked <- !is.na(assignments$linked_node_id) & nzchar(assignments$linked_node_id) + linked[is.na(linked)] <- FALSE + + out <- data.frame( + sample_id = assignments$sample_id, + sample_node_id = assignments$sample_node_id, + group_id = ifelse( + linked, + paste0(mode, ":", assignments$linked_key), + paste0(mode, ":unlinked:", assignments$sample_id) + ), + constraint_type = mode, + group_label = ifelse(linked, assignments$linked_key, paste0("unlinked_", assignments$sample_id)), + explanation = ifelse( + linked, + paste0(prefix, " through ", assignments$edge_type, " -> ", assignments$linked_key, "."), + paste0("No ", mode, " assignment was available; sample retained as an unlinked singleton group.") + ), + stringsAsFactors = FALSE + ) row.names(out) <- NULL out } @@ -209,9 +204,10 @@ time_consistency <- .depgraph_time_order_consistency(graph$nodes$data, graph$edges$data) if (length(time_consistency$self_loop_edge_ids) > 0L || length(time_consistency$cycle_edge_ids) > 0L) { - stop( + .depgraph_stop( "Time ordering metadata are inconsistent: `timepoint_precedes` must define an acyclic ordering.", - call. = FALSE + class = "splitgraph_validation_error", + code = "timepoint_precedence_cycle" ) } if (nrow(time_consistency$conflicting_pairs) > 0L) { @@ -220,12 +216,13 @@ " -> ", time_consistency$conflicting_pairs$to ) - stop( + .depgraph_stop( paste0( "Time ordering metadata conflict between `time_index` and `timepoint_precedes`: ", paste(pair_labels, collapse = ", ") ), - call. = FALSE + class = "splitgraph_validation_error", + code = "time_order_conflict" ) } @@ -521,10 +518,16 @@ via <- as.character(via) via_modes <- vapply(via, function(x) { x_lower <- tolower(x) - if (x_lower %in% names(.depgraph_constraint_mode_map)) { + # A mode name: direct ("subject", ...) or pairwise ("relatedness", "spatial"). + if (x_lower %in% .depgraph_composable_modes()) { return(x_lower) } - + # A pairwise relation name is accepted as an alias for its mode. + rel_idx <- match(x_lower, tolower(.depgraph_pairwise_relation)) + if (!is.na(rel_idx)) { + return(names(.depgraph_pairwise_relation)[[rel_idx]]) + } + # A node type ("Subject", ...) maps to its direct mode. match_idx <- match(x_lower, tolower(.depgraph_constraint_mode_map)) .depgraph_assert(!is.na(match_idx), paste0("Unsupported composite dependency source: ", x)) names(.depgraph_constraint_mode_map)[[match_idx]] @@ -533,68 +536,43 @@ unique(via_modes) } +# Human-readable labels for `metadata$via`: node types for direct modes, +# mode names for pairwise modes (which have no target node type). +.depgraph_via_labels <- function(via_modes) { + vapply(via_modes, function(mode) { + if (.depgraph_is_pairwise_mode(mode)) mode else unname(.depgraph_constraint_mode_map[[mode]]) + }, character(1), USE.NAMES = FALSE) +} + .derive_composite_strict_constraints <- function(graph, samples = NULL, via = NULL) { via_modes <- .depgraph_normalize_via_modes(via) - via_types <- unname(.depgraph_constraint_mode_map[via_modes]) - components <- detect_dependency_components(graph, via = via_types, min_size = 1) - table <- components$table - - if (!is.null(samples)) { - sample_nodes <- .depgraph_constraint_samples(graph, samples) - keep_ids <- sample_nodes$node_id - - # Recompute components within the requested subset only. Without this, - # two in-subset samples connected only through an out-of-subset sample - # would inherit a shared component_id from the full-graph projection, - # silently leaking out-of-subset structure into the produced split. - projection <- components$metadata$projection_edges - if (is.null(projection) || nrow(projection) == 0L) { - projection <- data.frame( - sample_node_id_1 = character(0), - sample_node_id_2 = character(0), - stringsAsFactors = FALSE - ) - } else { - projection <- projection[ - projection$sample_node_id_1 %in% keep_ids & - projection$sample_node_id_2 %in% keep_ids, - , drop = FALSE - ] - } - - subset_graph <- if (nrow(projection) == 0L) { - igraph::make_empty_graph(n = length(keep_ids), directed = FALSE) - } else { - igraph::graph_from_data_frame( - d = data.frame( - from = projection$sample_node_id_1, - to = projection$sample_node_id_2, - stringsAsFactors = FALSE - ), - vertices = data.frame(name = keep_ids, stringsAsFactors = FALSE), - directed = FALSE - ) - } - igraph::V(subset_graph)$name <- keep_ids - - sub_components <- igraph::components(subset_graph) - membership_idx <- as.integer(sub_components$membership[keep_ids]) - table <- data.frame( - sample_id = sample_nodes$node_key, - sample_node_id = keep_ids, - component_id = paste0("component_", membership_idx), - component_size = as.integer(sub_components$csize[membership_idx]), - stringsAsFactors = FALSE - ) - components$metadata$projection_edges <- projection + direct_modes <- via_modes[!.depgraph_is_pairwise_mode(via_modes)] + pairwise_modes <- via_modes[.depgraph_is_pairwise_mode(via_modes)] + via_types <- .depgraph_via_labels(via_modes) + edge_types <- vapply(via_modes, .depgraph_mode_relation, character(1), USE.NAMES = FALSE) + + # Components are computed on the bipartite sample-target graph restricted to + # the requested samples. Restricting the *edges* to in-subset samples is what + # keeps two in-subset samples apart when their only link runs through an + # out-of-subset sample: that sample's edges are simply absent, so the two + # targets it would have bridged stay disconnected. Pairwise relations add + # their own connecting edges (sample-sample for spatial, sample-subject plus + # subject-subject for relatedness) to the same component search. + sample_nodes <- .depgraph_constraint_samples(graph, samples) + keep_ids <- sample_nodes$node_id + dep_edges <- .depgraph_dependency_edges(graph, keep_ids, unname(.depgraph_constraint_edge_map[direct_modes]))[, c("from", "to"), drop = FALSE] + for (mode in pairwise_modes) { + dep_edges <- rbind(dep_edges, .depgraph_pairwise_component_edges(graph, mode, keep_ids)) } + comps <- .depgraph_sample_components(keep_ids, dep_edges) + component_id <- paste0("component_", comps$membership) sample_map <- data.frame( - sample_id = table$sample_id, - sample_node_id = table$sample_node_id, - group_id = table$component_id, + sample_id = sample_nodes$node_key, + sample_node_id = keep_ids, + group_id = component_id, constraint_type = "composite_strict", - group_label = table$component_id, + group_label = component_id, explanation = paste0( "Strict composite grouping via transitive closure over: ", paste(via_types, collapse = ", "), @@ -602,13 +580,11 @@ ), stringsAsFactors = FALSE ) + row.names(sample_map) <- NULL warnings <- character() - if (nrow(sample_map) > 0L) { - singleton_fraction <- mean(table$component_size == 1L) - if (singleton_fraction > 0.5) { - warnings <- c(warnings, "Most strict composite groups are singletons; dependency coverage may be sparse.") - } + if (nrow(sample_map) > 0L && mean(comps$size == 1L) > 0.5) { + warnings <- c(warnings, "Most strict composite groups are singletons; dependency coverage may be sparse.") } split_constraint( @@ -623,12 +599,12 @@ metadata = list( mode = "composite", strategy = "strict", - relations_used = unname(.depgraph_constraint_edge_map[via_modes]), + relations_used = edge_types, via = via_types, n_groups = length(unique(sample_map$group_id)), n_samples = nrow(sample_map), - warnings = warnings, - projection_edges = components$metadata$projection_edges + n_dependency_edges = nrow(dep_edges), + warnings = warnings ) ) } @@ -639,65 +615,78 @@ .depgraph_assert(all(priority %in% via_modes), "`priority` must be a subset of the selected composite dependency sources.") sample_nodes <- .depgraph_constraint_samples(graph, samples) - assignments <- lapply(priority, function(mode) .depgraph_direct_assignment(graph, mode, samples = sample_nodes$node_id)) - names(assignments) <- priority - time_info <- if ("time" %in% priority) .derive_time_constraints(graph, samples = sample_nodes$node_id)$sample_map else NULL - - rows <- lapply(seq_len(nrow(sample_nodes)), function(i) { - sample_row <- sample_nodes[i, , drop = FALSE] - sample_id <- sample_row$node_key[[1L]] - sample_node_id <- sample_row$node_id[[1L]] - - available <- lapply(assignments, function(x) x[x$sample_node_id == sample_node_id, , drop = FALSE]) - available_modes <- names(available)[vapply(available, function(x) nrow(x) == 1L && !is.na(x$linked_node_id[[1L]]), logical(1))] - - if (length(available_modes) == 0L) { - return(data.frame( - sample_id = sample_id, - sample_node_id = sample_node_id, - group_id = paste0("composite:unlinked:", sample_id), - constraint_type = "unlinked", - group_label = paste0("unlinked_", sample_id), - explanation = "No prioritized dependency assignment was available; sample retained as a singleton group.", - time_index = NA_real_, - timepoint_id = NA_character_, - order_rank = NA_integer_, - stringsAsFactors = FALSE - )) + sample_ids <- sample_nodes$node_id + n <- length(sample_ids) + + # One aligned key vector per prioritized mode (NA where the sample has no + # assignment). Direct modes use the single linked target; pairwise modes use + # the connected-component label, and a singleton component counts as "no + # assignment" so the sample falls through to the next mode in priority. + keys <- lapply(priority, function(mode) { + if (.depgraph_is_pairwise_mode(mode)) { + pairwise <- .derive_pairwise_constraints(graph, mode, samples = sample_ids)$sample_map + idx <- match(sample_ids, pairwise$sample_node_id) + group_size <- table(pairwise$group_id)[pairwise$group_id[idx]] + key <- pairwise$group_label[idx] + key[is.na(group_size) | group_size <= 1L] <- NA_character_ + return(key) } - - chosen_mode <- available_modes[[1L]] - chosen_row <- available[[chosen_mode]] - additional <- setdiff(available_modes, chosen_mode) - explanation <- paste0( - "Composite rule-based grouping selected ", chosen_mode, - " based on priority order ", paste(priority, collapse = " > "), - " -> ", chosen_row$linked_key[[1L]], "." + assignment <- .depgraph_direct_assignment(graph, mode, samples = sample_ids) + assignment$linked_key[match(sample_ids, assignment$sample_node_id)] + }) + names(keys) <- priority + key_matrix <- matrix(unlist(keys, use.names = FALSE), nrow = n, ncol = length(priority)) + available <- !is.na(key_matrix) + + # Highest-priority available mode per sample (column index of first TRUE). + first_idx <- apply(available, 1L, function(row) { + hit <- which(row) + if (length(hit) == 0L) NA_integer_ else hit[[1L]] + }) + if (n == 0L) first_idx <- integer() + has_mode <- !is.na(first_idx) + chosen_mode <- ifelse(has_mode, priority[first_idx], NA_character_) + chosen_key <- ifelse(has_mode, key_matrix[cbind(seq_len(n), ifelse(has_mode, first_idx, 1L))], NA_character_) + + # "Additional available dependencies" detail: every other available mode. + additional <- vapply(seq_len(n), function(i) { + if (!has_mode[[i]]) return("") + others <- which(available[i, ] & seq_along(priority) != first_idx[[i]]) + if (length(others) == 0L) return("") + paste0( + " Additional available dependencies: ", + paste(paste0(priority[others], "=", key_matrix[i, others]), collapse = ", "), + "." ) - if (length(additional) > 0L) { - detail <- vapply(additional, function(mode) { - paste0(mode, "=", available[[mode]]$linked_key[[1L]]) - }, character(1), USE.NAMES = FALSE) - explanation <- paste0(explanation, " Additional available dependencies: ", paste(detail, collapse = ", "), ".") - } + }, character(1)) - time_row <- if (!is.null(time_info)) time_info[time_info$sample_node_id == sample_node_id, , drop = FALSE] else NULL - - data.frame( - sample_id = sample_id, - sample_node_id = sample_node_id, - group_id = paste0("composite_", chosen_mode, ":", chosen_row$linked_key[[1L]]), - constraint_type = chosen_mode, - group_label = chosen_row$linked_key[[1L]], - explanation = explanation, - time_index = if (!is.null(time_row) && nrow(time_row) == 1L) time_row$time_index[[1L]] else NA_real_, - timepoint_id = if (!is.null(time_row) && nrow(time_row) == 1L) time_row$timepoint_id[[1L]] else NA_character_, - order_rank = if (!is.null(time_row) && nrow(time_row) == 1L) time_row$order_rank[[1L]] else NA_integer_, - stringsAsFactors = FALSE - ) - }) + time_info <- if ("time" %in% priority) .derive_time_constraints(graph, samples = sample_ids)$sample_map else NULL + time_idx <- if (is.null(time_info)) rep(NA_integer_, n) else match(sample_ids, time_info$sample_node_id) - sample_map <- do.call(rbind, rows) + sample_map <- data.frame( + sample_id = sample_nodes$node_key, + sample_node_id = sample_ids, + group_id = ifelse( + has_mode, + paste0("composite_", chosen_mode, ":", chosen_key), + paste0("composite:unlinked:", sample_nodes$node_key) + ), + constraint_type = ifelse(has_mode, chosen_mode, "unlinked"), + group_label = ifelse(has_mode, chosen_key, paste0("unlinked_", sample_nodes$node_key)), + explanation = ifelse( + has_mode, + paste0( + "Composite rule-based grouping selected ", chosen_mode, + " based on priority order ", paste(priority, collapse = " > "), + " -> ", chosen_key, ".", additional + ), + "No prioritized dependency assignment was available; sample retained as a singleton group." + ), + time_index = if (is.null(time_info)) rep(NA_real_, n) else as.numeric(time_info$time_index[time_idx]), + timepoint_id = if (is.null(time_info)) rep(NA_character_, n) else as.character(time_info$timepoint_id[time_idx]), + order_rank = if (is.null(time_info)) rep(NA_integer_, n) else as.integer(time_info$order_rank[time_idx]), + stringsAsFactors = FALSE + ) row.names(sample_map) <- NULL warnings <- character() if (any(sample_map$constraint_type == "unlinked")) { @@ -719,7 +708,8 @@ metadata = list( mode = "composite", strategy = "rule_based", - relations_used = unname(.depgraph_constraint_edge_map[priority]), + relations_used = vapply(priority, .depgraph_mode_relation, character(1), USE.NAMES = FALSE), + via = .depgraph_via_labels(via_modes), priority = priority, n_groups = length(unique(sample_map$group_id)), n_samples = nrow(sample_map), @@ -817,7 +807,15 @@ #' modes. #' @param via Optional dependency sources used for composite grouping. May be #' given as lower-case modes such as \code{"subject"} or node types such as -#' \code{"Subject"}. +#' \code{"Subject"}. Any direct-assignment source (\code{"subject"}, +#' \code{"batch"}, \code{"study"}, \code{"time"}, \code{"site"}, +#' \code{"region"}, \code{"platform"}, \code{"assay"}) and either pairwise +#' source (\code{"relatedness"}, \code{"spatial"}) can be combined. In the +#' strict strategy a pairwise source contributes its thresholded edges to the +#' same connected-component search as the direct relations; in the +#' rule-based strategy it contributes the component label, and a singleton +#' component counts as "no assignment" so the sample falls through to the +#' next mode. Defaults to \code{c("subject", "batch", "study", "time")}. #' @param priority Optional priority order used for #' \code{strategy = "rule_based"}. #' @param include_warnings Whether to retain human-readable warnings in the @@ -838,10 +836,19 @@ #' constraint <- derive_split_constraints(g, mode = "subject") #' grouping_vector(constraint) #' @export -derive_split_constraints <- function(graph, mode = c("subject", "batch", "study", "time", "site", "region", "platform", "assay", "relatedness", "spatial", "composite"), samples = NULL, strategy = c("strict", "rule_based"), via = NULL, priority = NULL, include_warnings = TRUE) { +derive_split_constraints <- function(graph, + mode = c("subject", "batch", "study", "time", "site", "region", + "platform", "assay", "relatedness", "spatial", "composite"), + samples = NULL, + strategy = c("strict", "rule_based"), + via = NULL, + priority = NULL, + include_warnings = TRUE) { .depgraph_assert(inherits(graph, "dependency_graph"), "`graph` must be a `dependency_graph`.") - mode <- .depgraph_normalize_constraint_mode(match.arg(mode)) - strategy <- match.arg(strategy) + mode <- .depgraph_normalize_constraint_mode( + .depgraph_match_arg(mode, .depgraph_constraint_modes, "mode") + ) + strategy <- .depgraph_match_arg(strategy, c("strict", "rule_based"), "strategy") result <- switch( mode, diff --git a/R/constructors.R b/R/constructors.R index 3506403..e0794e0 100644 --- a/R/constructors.R +++ b/R/constructors.R @@ -14,8 +14,6 @@ #' auxiliary metadata. #' @param query Query label stored on a \code{graph_query_result}. #' @param table Tabular query result payload. -#' @param constraint_id,relation_types,transitive Fields describing a -#' dependency constraint. #' @param sample_map Sample-level mapping table for constraints. #' @param strategy Split strategy identifier. #' @return An S3 object corresponding to the constructor that was called. @@ -106,39 +104,6 @@ dependency_graph <- function(nodes, edges, graph, metadata = list(), caches = li ) } -#' @rdname graph_node_set -#' @export -new_depgraph_nodes <- function(data = NULL, schema_version = .depgraph_schema_version, source = list()) { - .Deprecated( - new = "graph_node_set", - package = "splitGraph", - msg = "`new_depgraph_nodes()` is deprecated. Use `graph_node_set()` instead." - ) - graph_node_set(data = data, schema_version = schema_version, source = source) -} - -#' @rdname graph_node_set -#' @export -new_depgraph_edges <- function(data = NULL, schema_version = .depgraph_schema_version, source = list()) { - .Deprecated( - new = "graph_edge_set", - package = "splitGraph", - msg = "`new_depgraph_edges()` is deprecated. Use `graph_edge_set()` instead." - ) - graph_edge_set(data = data, schema_version = schema_version, source = source) -} - -#' @rdname graph_node_set -#' @export -new_depgraph <- function(nodes, edges, graph = NULL, metadata = list(), caches = list()) { - .Deprecated( - new = "dependency_graph", - package = "splitGraph", - msg = "`new_depgraph()` is deprecated. Use `dependency_graph()` instead." - ) - dependency_graph(nodes = nodes, edges = edges, graph = graph, metadata = metadata, caches = caches) -} - #' @rdname graph_node_set #' @export graph_query_result <- function(query = "", params = list(), nodes = NULL, edges = NULL, table = NULL, metadata = list()) { @@ -155,22 +120,6 @@ graph_query_result <- function(query = "", params = list(), nodes = NULL, edges ) } -#' @rdname graph_node_set -#' @export -dependency_constraint <- function(constraint_id, relation_types, sample_map, transitive = TRUE, metadata = list()) { - .depgraph_assert(is.data.frame(sample_map), "`sample_map` must be a data.frame.") - structure( - list( - constraint_id = as.character(constraint_id)[1L], - relation_types = as.character(relation_types), - sample_map = sample_map, - transitive = isTRUE(transitive), - metadata = metadata - ), - class = "dependency_constraint" - ) -} - #' @rdname graph_node_set #' @export split_constraint <- function(strategy, sample_map, recommended_downstream_args = list(), metadata = list()) { @@ -221,6 +170,9 @@ split_constraint <- function(strategy, sample_map, recommended_downstream_args = #' @param group_var Name of the grouping column. #' @param block_vars Optional blocking variable names. #' @param time_var Optional ordering column name. +#' @param stratum_var Optional name of the column carrying the stratum +#' annotation (the outcome level each sample carries). An annotation only: +#' splitGraph never balances folds. #' @param ordering_required Whether ordering is required for downstream #' evaluation. #' @param constraint_mode,constraint_strategy Constraint-derivation metadata. @@ -242,7 +194,9 @@ split_constraint <- function(strategy, sample_map, recommended_downstream_args = #' report$valid #' summary(report) #' @export -depgraph_validation_report <- function(graph_name = NULL, issues = NULL, metrics = list(), metadata = list(), valid = NULL, errors = NULL, warnings = NULL, advisories = NULL) { +depgraph_validation_report <- function(graph_name = NULL, issues = NULL, metrics = list(), + metadata = list(), valid = NULL, errors = NULL, + warnings = NULL, advisories = NULL) { if (is.null(issues)) { issues <- data.frame( issue_id = character(), @@ -303,20 +257,12 @@ depgraph_validation_report <- function(graph_name = NULL, issues = NULL, metrics #' @rdname depgraph_validation_report #' @export -split_spec <- function(sample_data = NULL, group_var = "group_id", block_vars = character(), time_var = NULL, ordering_required = FALSE, constraint_mode = NULL, constraint_strategy = NULL, recommended_resampling = NULL, metadata = list()) { +split_spec <- function(sample_data = NULL, group_var = "group_id", block_vars = character(), + time_var = NULL, stratum_var = NULL, ordering_required = FALSE, + constraint_mode = NULL, constraint_strategy = NULL, + recommended_resampling = NULL, metadata = list()) { if (is.null(sample_data)) { - sample_data <- data.frame( - sample_id = character(), - sample_node_id = character(), - group_id = character(), - primary_group = character(), - batch_group = character(), - study_group = character(), - timepoint_id = character(), - time_index = numeric(), - order_rank = integer(), - stringsAsFactors = FALSE - ) + sample_data <- .split_spec_sample_data_template(0L) } .depgraph_assert(is.data.frame(sample_data), "`sample_data` must be a data.frame.") @@ -327,6 +273,7 @@ split_spec <- function(sample_data = NULL, group_var = "group_id", block_vars = group_var = as.character(group_var)[1L], block_vars = as.character(block_vars), time_var = if (is.null(time_var)) NULL else as.character(time_var)[1L], + stratum_var = if (is.null(stratum_var)) NULL else as.character(stratum_var)[1L], ordering_required = isTRUE(ordering_required), constraint_mode = if (is.null(constraint_mode)) NULL else as.character(constraint_mode)[1L], constraint_strategy = if (is.null(constraint_strategy)) NULL else as.character(constraint_strategy)[1L], @@ -371,7 +318,9 @@ split_spec_validation <- function(issues = NULL, metadata = list()) { #' @rdname depgraph_validation_report #' @export -leakage_risk_summary <- function(overview = character(), diagnostics = NULL, validation_summary = list(), constraint_summary = list(), split_spec_summary = list(), metadata = list()) { +leakage_risk_summary <- function(overview = character(), diagnostics = NULL, + validation_summary = list(), constraint_summary = list(), + split_spec_summary = list(), metadata = list()) { if (is.null(diagnostics)) { diagnostics <- data.frame( severity = character(), @@ -379,6 +328,7 @@ leakage_risk_summary <- function(overview = character(), diagnostics = NULL, val message = character(), source = character(), n_affected = integer(), + severed = logical(), stringsAsFactors = FALSE ) } diff --git a/R/export.R b/R/export.R new file mode 100644 index 0000000..a795f32 --- /dev/null +++ b/R/export.R @@ -0,0 +1,101 @@ +# Export a dependency_graph to formats other tools read (GraphML, GML, CSV). + +# Flatten a list-column of named attribute lists into typed columns named +# "attr_". A value of length > 1 is collapsed with ";"; a column whose +# values are all numeric (or all logical) keeps that type, anything else +# becomes character. GraphML/GML attributes must be scalars, and CSV has no +# nesting, so this is the only faithful representation available. +.depgraph_flatten_attrs <- function(attrs, prefix = "attr_") { + n <- length(attrs) + attr_names <- unique(unlist(lapply(attrs, names), use.names = FALSE)) + if (length(attr_names) == 0L) { + return(data.frame(row.names = seq_len(n))[, FALSE, drop = FALSE]) + } + columns <- lapply(attr_names, function(name) { + values <- lapply(attrs, function(a) a[[name]]) + scalar <- lengths(values) <= 1L + values[!scalar] <- lapply(values[!scalar], function(v) paste(as.character(v), collapse = ";")) + values[lengths(values) == 0L] <- list(NA) + flat <- unlist(lapply(values, function(v) v[[1L]]), use.names = FALSE) + if (is.numeric(flat) || is.logical(flat)) flat else as.character(flat) + }) + names(columns) <- paste0(prefix, attr_names) + as.data.frame(columns, stringsAsFactors = FALSE, optional = TRUE) +} + +.depgraph_export_tables <- function(graph) { + nodes <- graph$nodes$data + edges <- graph$edges$data + node_table <- cbind( + nodes[, c("node_id", "node_type", "node_key", "label"), drop = FALSE], + .depgraph_flatten_attrs(nodes$attrs) + ) + edge_table <- cbind( + edges[, c("from", "to", "edge_id", "edge_type"), drop = FALSE], + .depgraph_flatten_attrs(edges$attrs) + ) + row.names(node_table) <- NULL + row.names(edge_table) <- NULL + list(nodes = node_table, edges = edge_table) +} + +#' Export a Dependency Graph for Other Tools +#' +#' Write a \code{dependency_graph} as GraphML or GML (readable by Cytoscape, +#' Gephi, networkx, and \code{igraph::read_graph()}), or as flat CSV tables of +#' nodes or edges. This complements the lossless JSON format of +#' \code{\link{write_dependency_graph}}: the JSON round-trips exactly and is +#' the interchange contract; these exports are for visual inspection and +#' analysis in graph tools and lose nothing but the nesting of attributes. +#' +#' Node attributes (the \code{attrs} list-column) are flattened into scalar +#' columns named \code{attr_}; multi-valued attributes are collapsed with +#' \code{";"}. Canonical columns (\code{node_id}, \code{node_type}, +#' \code{node_key}, \code{label}; \code{edge_id}, \code{edge_type}) are written +#' as-is. In GraphML/GML the vertex \code{name} is the \code{node_id}. +#' +#' @param graph A \code{dependency_graph}. +#' @param file Path to write. For the CSV formats this is the single table +#' requested (\code{nodes_csv} writes the node table, \code{edges_csv} the +#' edge table). +#' @param format One of \code{"graphml"}, \code{"gml"}, \code{"nodes_csv"}, +#' \code{"edges_csv"}. +#' @return The normalised output path, invisibly. +#' @examples +#' meta <- data.frame(sample_id = c("S1", "S2"), subject_id = c("P1", "P2")) +#' g <- graph_from_metadata(meta) +#' tmp <- tempfile(fileext = ".graphml") +#' export_graph(g, tmp, format = "graphml") +#' igraph::vcount(igraph::read_graph(tmp, format = "graphml")) +#' unlink(tmp) +#' @export +export_graph <- function(graph, file, format = c("graphml", "gml", "nodes_csv", "edges_csv")) { + .depgraph_assert(inherits(graph, "dependency_graph"), "`graph` must be a `dependency_graph`.") + .depgraph_assert(is.character(file) && length(file) == 1L && nzchar(file), "`file` must be a single non-empty file path.") + format <- .depgraph_match_arg(format, c("graphml", "gml", "nodes_csv", "edges_csv"), "format") + .depgraph_check_writable_path(file) + + tables <- .depgraph_export_tables(graph) + + if (identical(format, "nodes_csv")) { + utils::write.csv(tables$nodes, file, row.names = FALSE, na = "") + } else if (identical(format, "edges_csv")) { + utils::write.csv(tables$edges, file, row.names = FALSE, na = "") + } else { + vertices <- tables$nodes + names(vertices)[names(vertices) == "node_id"] <- "name" + g <- igraph::graph_from_data_frame(tables$edges, vertices = vertices, directed = TRUE) + if (identical(format, "gml")) { + # Supply the GML node ids explicitly. Leaving `id` at its NULL default + # makes igraph's own writer hand a zero-length vector to the C layer in + # some versions, which then rejects it ("Size of id vector must match + # vertex count"). An explicit 1..n is what the writer would have produced + # anyway and is accepted by every version. + igraph::write_graph(g, file, format = format, id = seq_len(igraph::vcount(g))) + } else { + igraph::write_graph(g, file, format = format) + } + } + + invisible(normalizePath(file, winslash = "/", mustWork = FALSE)) +} diff --git a/R/graph-build-auto.R b/R/graph-build-auto.R index 061a4bc..0441a05 100644 --- a/R/graph-build-auto.R +++ b/R/graph-build-auto.R @@ -24,8 +24,10 @@ #' @param meta A \code{data.frame} containing one row per sample and optional #' canonical columns: \code{sample_id} (required), \code{subject_id}, #' \code{batch_id}, \code{study_id}, \code{timepoint_id}, \code{time_index}, -#' \code{assay_id}, \code{featureset_id}, \code{outcome_id}, or -#' \code{outcome_value}. +#' \code{assay_id}, \code{featureset_id}, \code{site_id}, \code{region_id}, +#' \code{platform_id}, \code{outcome_id}, or \code{outcome_value}. +#' Identifier columns may be character, factor, or numeric; they are +#' coerced to character by \code{ingest_metadata()}. #' @param columns Optional named character vector passed to #' \code{ingest_metadata()} to rename user columns to canonical names. #' @param dataset_name,graph_name Optional metadata labels. @@ -36,7 +38,22 @@ #' \code{time_index}. #' @param validate Forwarded to \code{build_dependency_graph()}. #' @param validation_overrides Forwarded to \code{build_dependency_graph()}. +#' @param ... Passed on to the \code{data.frame} method. +#' @param sample_id_col For the \code{SummarizedExperiment} method: the +#' \code{colData} column holding sample identifiers. When \code{NULL} +#' (default) a \code{sample_id} column is used if present, otherwise the +#' assay column names (\code{colnames(se)}) become the sample identifiers. #' @return A validated \code{dependency_graph}. +#' @details +#' \code{graph_from_metadata()} is an S3 generic. The \code{data.frame} method +#' is the one described above. The \code{SummarizedExperiment} method (used +#' when Bioconductor's \pkg{SummarizedExperiment} is installed) converts +#' \code{colData(se)} to a data frame, adds \code{sample_id} from the assay +#' column names when \code{colData} has no such column, and dispatches to the +#' \code{data.frame} method; \code{columns} maps \code{colData} names to the +#' canonical ones exactly as for a data frame. A worked example is in +#' \code{vignette("faq-design-notes")}; it is kept out of the examples below +#' because attaching Bioconductor packages dominates their run time. #' @examples #' meta <- data.frame( #' sample_id = c("S1", "S2", "S3", "S4"), @@ -50,16 +67,63 @@ #' g <- graph_from_metadata(meta, graph_name = "demo") #' g #' @export -graph_from_metadata <- function(meta, - columns = NULL, - dataset_name = NULL, - graph_name = NULL, - outcome_scope = c("sample", "subject"), - time_precedence = TRUE, - validate = TRUE, - validation_overrides = list()) { +graph_from_metadata <- function(meta, ...) { + UseMethod("graph_from_metadata") +} + +#' @rdname graph_from_metadata +#' @export +graph_from_metadata.default <- function(meta, ...) { + .depgraph_stop( + paste0( + "`meta` must be a data.frame or a SummarizedExperiment; got <", + paste(class(meta), collapse = "/"), ">." + ), + class = "splitgraph_schema_error", code = "unsupported_metadata_input" + ) +} + +#' @rdname graph_from_metadata +#' @export +graph_from_metadata.SummarizedExperiment <- function(meta, ..., sample_id_col = NULL) { + .depgraph_assert( + requireNamespace("SummarizedExperiment", quietly = TRUE), + "Package 'SummarizedExperiment' is required to build a graph from a SummarizedExperiment." + ) + col_data <- as.data.frame(SummarizedExperiment::colData(meta), stringsAsFactors = FALSE, optional = TRUE) + sample_names <- colnames(meta) + + if (!is.null(sample_id_col)) { + .depgraph_assert( + sample_id_col %in% names(col_data), + paste0("`sample_id_col` not found in colData: ", sample_id_col), + class = "splitgraph_reference_error", code = "missing_sample_id_column" + ) + col_data$sample_id <- as.character(col_data[[sample_id_col]]) + } else if (!"sample_id" %in% names(col_data)) { + .depgraph_assert( + !is.null(sample_names) && all(nzchar(sample_names)), + "The SummarizedExperiment has no `sample_id` column in colData and no column names to use instead." + ) + col_data$sample_id <- as.character(sample_names) + } + row.names(col_data) <- NULL + graph_from_metadata.data.frame(col_data, ...) +} + +#' @rdname graph_from_metadata +#' @export +graph_from_metadata.data.frame <- function(meta, + columns = NULL, + dataset_name = NULL, + graph_name = NULL, + outcome_scope = c("sample", "subject"), + time_precedence = TRUE, + validate = TRUE, + validation_overrides = list(), + ...) { .depgraph_assert(is.data.frame(meta), "`meta` must be a data.frame.") - outcome_scope <- match.arg(outcome_scope) + outcome_scope <- .depgraph_match_arg(outcome_scope, c("sample", "subject"), "outcome_scope") meta <- ingest_metadata(meta, col_map = columns, dataset_name = dataset_name, strict = TRUE) @@ -119,12 +183,12 @@ graph_from_metadata <- function(meta, if (any(present)) { sub <- meta[present, , drop = FALSE] if (identical(outcome_col, "outcome_value") && is.numeric(meta[[outcome_col]])) { - warning( - "`outcome_value` is numeric: graph_from_metadata() will create one ", - "Outcome node per distinct numeric value (e.g. `outcome:0`, `outcome:1`). ", - "If you intended a class label, pass `outcome_id` (character) instead, ", - "or coerce `outcome_value` to a character class label first.", - call. = FALSE + .depgraph_warn( + c("`outcome_value` is numeric: graph_from_metadata() will create one ", + "Outcome node per distinct numeric value (e.g. `outcome:0`, `outcome:1`). ", + "If you intended a class label, pass `outcome_id` (character) instead, ", + "or coerce `outcome_value` to a character class label first."), + code = "numeric_outcome_value" ) } sub$outcome_id <- as.character(sub[[outcome_col]]) @@ -151,7 +215,10 @@ graph_from_metadata <- function(meta, build_dependency_graph( nodes = node_sets, - edges = edge_sets, + # `sample_id` is the only required column, so a table carrying nothing else + # is legitimate and must yield an edgeless graph rather than an internal + # "non-empty list" error from the binder. + edges = if (length(edge_sets) == 0L) list(graph_edge_set()) else edge_sets, graph_name = graph_name, dataset_name = dataset_name, validate = validate, diff --git a/R/graph-build.R b/R/graph-build.R index a4c4077..732596d 100644 --- a/R/graph-build.R +++ b/R/graph-build.R @@ -32,6 +32,24 @@ paste0(base_msg, hint) } +# Provenance of each edge set, keyed by relation: the source columns recorded +# by `create_edges()` and, for the thresholded pairwise helpers, the threshold +# and metric that were applied. Carried in `metadata$edge_sources` so a +# derivation (and the written split_spec) can report the threshold behind a +# relatedness or spatial grouping. When several sets share a relation the last +# one wins; they cannot carry different thresholds in a valid graph anyway. +.depgraph_collect_edge_sources <- function(edge_sets) { + if (inherits(edge_sets, "graph_edge_set")) edge_sets <- list(edge_sets) + out <- list() + for (set in edge_sets) { + src <- set$source + relation <- src$relation + if (is.null(relation) || !nzchar(relation)) next + out[[relation]] <- src + } + out +} + #' Assemble and Validate Dependency Graphs #' #' Combine canonical node and edge tables into a typed dependency graph and @@ -50,12 +68,10 @@ #' first listed subject assignment (recording the ambiguity in #' \code{metadata$warnings}). Defaults to \code{FALSE}.} #' } -#' When passed to \code{validate_graph()} or \code{validate_depgraph()}, -#' the override is merged into the graph's existing -#' \code{validation_overrides} for the duration of the call only. +#' When passed to \code{validate_graph()}, the override is merged into the +#' graph's existing \code{validation_overrides} for the duration of the call +#' only. #' @param graph A \code{dependency_graph}. -#' @param checks \strong{Deprecated.} Use \code{levels} and \code{severities} -#' instead. Retained for backward compatibility with 0.1.0 callers. #' @param error_on_fail If \code{TRUE}, stop when validation errors are found #' across all detected issues from the selected validation levels, even if #' those errors are hidden from \code{issues} by \code{severities}. @@ -65,9 +81,8 @@ #' considered valid. #' @param x A \code{dependency_graph}. #' @return For \code{build_dependency_graph()}, a \code{dependency_graph}. For -#' \code{validate_graph()} and \code{validate_depgraph()}, a -#' \code{depgraph_validation_report}. For \code{as_igraph()}, the underlying -#' \code{igraph} object. +#' \code{validate_graph()}, a \code{depgraph_validation_report}. For +#' \code{as_igraph()}, the underlying \code{igraph} object. #' @examples #' meta <- data.frame( #' sample_id = c("S1", "S2"), @@ -91,17 +106,38 @@ build_dependency_graph <- function(nodes, edges, graph_name = NULL, dataset_name = NULL, validate = TRUE, validation_overrides = list()) { node_data <- .depgraph_bind_data(nodes, "data") edge_data <- .depgraph_bind_data(edges, "data") + edge_sources <- .depgraph_collect_edge_sources(edges) + # Overrides are looked up by name, and an unnamed list would also serialise + # as a JSON array where the schema declares an object. Reject it here rather + # than writing an invalid file later. + .depgraph_assert( + is.list(validation_overrides) && + (length(validation_overrides) == 0L || + (!is.null(names(validation_overrides)) && all(nzchar(names(validation_overrides))))), + "`validation_overrides` must be a named list.", + code = "invalid_argument" + ) - .depgraph_assert(any(node_data$node_type == "Sample"), "A dependency graph must contain at least one `Sample` node.") - .depgraph_assert(anyDuplicated(node_data$node_id) == 0L, "Duplicate `node_id` values found in node sets.") - .depgraph_assert(anyDuplicated(edge_data$edge_id) == 0L, "Duplicate `edge_id` values found in edge sets.") + .depgraph_assert( + any(node_data$node_type == "Sample"), "A dependency graph must contain at least one `Sample` node.", + class = "splitgraph_schema_error", code = "missing_sample_nodes" + ) + .depgraph_assert( + anyDuplicated(node_data$node_id) == 0L, "Duplicate `node_id` values found in node sets.", + class = "splitgraph_reference_error", code = "duplicate_node_id" + ) + .depgraph_assert( + anyDuplicated(edge_data$edge_id) == 0L, "Duplicate `edge_id` values found in edge sets.", + class = "splitgraph_reference_error", code = "duplicate_edge_id" + ) .depgraph_assert( all(edge_data$from %in% node_data$node_id), .depgraph_missing_reference_message( missing = setdiff(unique(edge_data$from), node_data$node_id), node_ids = node_data$node_id, side = "from" - ) + ), + class = "splitgraph_reference_error", code = "missing_source_node" ) .depgraph_assert( all(edge_data$to %in% node_data$node_id), @@ -109,7 +145,8 @@ build_dependency_graph <- function(nodes, edges, graph_name = NULL, dataset_name missing = setdiff(unique(edge_data$to), node_data$node_id), node_ids = node_data$node_id, side = "to" - ) + ), + class = "splitgraph_reference_error", code = "missing_target_node" ) graph_obj <- dependency_graph( @@ -121,19 +158,21 @@ build_dependency_graph <- function(nodes, edges, graph_name = NULL, dataset_name dataset_name = dataset_name, created_at = Sys.time(), schema_version = .depgraph_schema_version, - validation_overrides = validation_overrides + validation_overrides = validation_overrides, + edge_sources = edge_sources ) ) if (isTRUE(validate)) { validation <- validate_graph(graph_obj) if (!isTRUE(validation$valid)) { - stop( + .depgraph_stop( paste( c("Graph validation failed.", validation$errors, validation$warnings), collapse = "\n" ), - call. = FALSE + class = "splitgraph_validation_error", + code = "graph_validation_failed" ) } } @@ -141,24 +180,6 @@ build_dependency_graph <- function(nodes, edges, graph_name = NULL, dataset_name graph_obj } -#' @rdname build_dependency_graph -#' @export -build_depgraph <- function(nodes, edges, graph_name = NULL, dataset_name = NULL, validate = TRUE, validation_overrides = list()) { - .Deprecated( - new = "build_dependency_graph", - package = "splitGraph", - msg = "`build_depgraph()` is deprecated. Use `build_dependency_graph()` instead." - ) - build_dependency_graph( - nodes = nodes, - edges = edges, - graph_name = graph_name, - dataset_name = dataset_name, - validate = validate, - validation_overrides = validation_overrides - ) -} - #' @rdname build_dependency_graph #' @export as_igraph <- function(x) { diff --git a/R/graph-edit.R b/R/graph-edit.R new file mode 100644 index 0000000..87ca878 --- /dev/null +++ b/R/graph-edit.R @@ -0,0 +1,268 @@ +# Graph editing: subset to a sample set, combine graphs, add edge sets. + +# Give every edge an id of the form ":", numbering within each +# edge type. Ids in `reserve` are left untouched and their indices skipped, so +# edges added to an existing graph never collide with ids callers already hold. +.depgraph_renumber_edge_ids <- function(edge_data, reserve = character()) { + if (nrow(edge_data) == 0L) return(edge_data) + keep <- !is.na(edge_data$edge_id) & edge_data$edge_id %in% reserve + new_ids <- edge_data$edge_id + for (type in unique(edge_data$edge_type[!keep])) { + idx <- which(!keep & edge_data$edge_type == type) + used <- suppressWarnings(as.integer(sub("^.*:", "", edge_data$edge_id[keep & edge_data$edge_type == type]))) + start <- if (length(used) == 0L || all(is.na(used))) 0L else max(used, na.rm = TRUE) + new_ids[idx] <- paste0(type, ":", start + seq_along(idx)) + } + edge_data$edge_id <- new_ids + edge_data +} + +# Drop exact duplicate (from, to, edge_type, attrs) rows; error on rows that +# share (from, to, edge_type) but differ in attrs. +.depgraph_dedupe_edges <- function(edge_data) { + if (nrow(edge_data) == 0L) return(edge_data) + key <- paste(edge_data$from, edge_data$to, edge_data$edge_type, sep = "\r") + attr_key <- vapply(edge_data$attrs, function(a) paste(deparse(a), collapse = ""), character(1)) + full_key <- paste(key, attr_key, sep = "\r") + distinct <- !duplicated(full_key) + conflicting <- unique(key[distinct][duplicated(key[distinct])]) + if (length(conflicting) > 0L) { + labels <- vapply(strsplit(conflicting, "\r", fixed = TRUE), function(p) paste0(p[[1L]], " -> ", p[[2L]], " [", p[[3L]], "]"), character(1)) + .depgraph_stop( + paste0("Conflicting edge definitions found for relations: ", paste(labels, collapse = ", ")), + class = "splitgraph_ambiguity_error", code = "conflicting_edge_definitions" + ) + } + out <- edge_data[distinct, , drop = FALSE] + row.names(out) <- NULL + out +} + +# Drop exact duplicate node rows; error on rows that share node_id but differ. +.depgraph_dedupe_nodes <- function(node_data) { + if (nrow(node_data) == 0L) return(node_data) + attr_key <- vapply(node_data$attrs, function(a) paste(deparse(a), collapse = ""), character(1)) + full_key <- paste(node_data$node_id, node_data$node_type, node_data$node_key, node_data$label, attr_key, sep = "\r") + distinct <- !duplicated(full_key) + ids <- node_data$node_id[distinct] + conflicting <- unique(ids[duplicated(ids)]) + if (length(conflicting) > 0L) { + .depgraph_stop( + paste0("Conflicting node definitions found for IDs: ", paste(conflicting, collapse = ", ")), + class = "splitgraph_ambiguity_error", code = "conflicting_node_definitions" + ) + } + out <- node_data[distinct, , drop = FALSE] + row.names(out) <- NULL + out +} + +# Rebuild a dependency_graph from edited tables, carrying over the metadata +# that build_dependency_graph() cannot reconstruct from node/edge sets alone. +.depgraph_rebuild <- function(node_data, edge_data, metadata, graph_name, dataset_name, validate, extra_metadata = list()) { + out <- build_dependency_graph( + nodes = list(graph_node_set(node_data)), + edges = list(graph_edge_set(edge_data)), + graph_name = graph_name, + dataset_name = dataset_name, + validate = validate, + validation_overrides = metadata$validation_overrides %||% list() + ) + sources <- metadata$edge_sources %||% list() + out$metadata$edge_sources <- sources[names(sources) %in% unique(edge_data$edge_type)] + out$metadata <- utils::modifyList(out$metadata, extra_metadata) + out +} + +#' Edit Dependency Graphs +#' +#' Derive a new \code{dependency_graph} from existing ones without rebuilding +#' from node and edge sets: restrict a graph to a subset of samples, take the +#' union of several graphs, or append edge sets to a graph. Every function +#' returns a new, independently validated \code{dependency_graph}; the inputs +#' are never modified. +#' +#' \code{subset_graph()} keeps the requested \code{Sample} nodes, every edge +#' rooted at one of them (a \code{sample_adjacent_to} edge is kept only when +#' both samples are kept), the non-sample nodes those edges point to, and, +#' transitively, non-sample nodes reachable from kept nodes through +#' non-sample edges (\code{assay_uses_platform}, +#' \code{featureset_generated_from_*}, \code{subject_related_to}, +#' \code{subject_has_outcome}). \code{timepoint_precedes} edges are kept only +#' between retained timepoints, so when \code{time_index} is absent the +#' ordering of a subset may become partial; \code{derive_split_constraints(mode +#' = "time")} reports that in its warnings. Restricting the graph this way has +#' the same semantics as the \code{samples} argument of +#' \code{\link{derive_split_constraints}}: structure that only reaches the +#' subset through excluded samples is dropped. +#' +#' \code{combine_graphs()} takes the union of node and edge tables. Identical +#' rows are collapsed; a node id or an \code{(from, to, edge_type)} relation +#' defined differently in two graphs is an error of class +#' \code{splitgraph_ambiguity_error}. Edge ids are regenerated per edge type +#' (\code{":"}), since ids from different graphs would collide. +#' Metadata \code{validation_overrides} and \code{edge_sources} are merged with +#' later graphs taking precedence. +#' +#' \code{add_edges()} appends one or more \code{graph_edge_set}s (for example +#' the output of \code{\link{relatedness_edges_from_kinship}}) to a graph. New +#' edges receive ids that continue the existing numbering of their edge type; +#' existing ids are preserved. Endpoints must already exist in the graph. +#' +#' @param graph A \code{dependency_graph}. +#' @param samples Sample identifiers or sample node ids to keep. All must +#' resolve; unknown ids raise a \code{splitgraph_reference_error}. +#' @param ... For \code{combine_graphs()}, two or more \code{dependency_graph}s +#' (or a single list of them). +#' @param edges A \code{graph_edge_set} or a list of them. +#' @param graph_name,dataset_name Optional labels for the result. When +#' \code{NULL}, \code{subset_graph()} and \code{add_edges()} inherit the +#' input's labels, and \code{combine_graphs()} uses the first non-\code{NULL} +#' label among its inputs. +#' @param validate If \code{TRUE} (default), run \code{validate_graph()} on the +#' result and fail on error-severity issues, as +#' \code{build_dependency_graph()} does. +#' @return A \code{dependency_graph}. +#' @examples +#' meta <- data.frame( +#' sample_id = c("S1", "S2", "S3", "S4"), +#' subject_id = c("P1", "P1", "P2", "P3"), +#' batch_id = c("B1", "B1", "B2", "B2") +#' ) +#' g <- graph_from_metadata(meta, graph_name = "full") +#' +#' g_sub <- subset_graph(g, samples = c("S1", "S2")) +#' summary(g_sub)$node_types +#' +#' pairs <- data.frame(id1 = "P1", id2 = "P2", kinship = 0.25) +#' g_kin <- add_edges(g, relatedness_edges_from_kinship(pairs, threshold = 0.1)) +#' grouping_vector(derive_split_constraints(g_kin, mode = "relatedness")) +#' +#' meta2 <- data.frame(sample_id = c("S5", "S6"), subject_id = c("P3", "P4")) +#' g_all <- combine_graphs(g, graph_from_metadata(meta2)) +#' summary(g_all)$n_nodes +#' @name graph_edit +#' @export +subset_graph <- function(graph, samples, graph_name = NULL, dataset_name = NULL, validate = TRUE) { + .depgraph_assert(inherits(graph, "dependency_graph"), "`graph` must be a `dependency_graph`.") + .depgraph_assert(!is.null(samples) && length(samples) > 0L, "`samples` must name at least one sample.") + + node_data <- graph$nodes$data + edge_data <- graph$edges$data + keep_samples <- .depgraph_resolve_sample_node_ids(graph, samples) + all_samples <- node_data$node_id[node_data$node_type == "Sample"] + dropped_samples <- setdiff(all_samples, keep_samples) + + # Edges rooted at kept samples; a sample-sample edge needs both ends kept. + sample_rooted <- edge_data$from %in% keep_samples & !(edge_data$to %in% dropped_samples) + kept_nodes <- unique(c(keep_samples, edge_data$to[sample_rooted])) + + # Transitive closure over non-sample edges, except timepoint_precedes. + non_sample_edge <- !(edge_data$from %in% all_samples) & !(edge_data$to %in% all_samples) & + edge_data$edge_type != "timepoint_precedes" + repeat { + reach <- non_sample_edge & edge_data$from %in% kept_nodes & !(edge_data$to %in% kept_nodes) + if (!any(reach)) break + kept_nodes <- unique(c(kept_nodes, edge_data$to[reach])) + } + # Undirected-in-spirit relations (subject_related_to) can also reach a kept + # node from their `to` side; include those neighbours once as well. + undirected <- edge_data$edge_type == "subject_related_to" & edge_data$to %in% kept_nodes & !(edge_data$from %in% kept_nodes) + kept_nodes <- unique(c(kept_nodes, edge_data$from[undirected])) + + keep_edge <- sample_rooted | + (non_sample_edge & edge_data$from %in% kept_nodes & edge_data$to %in% kept_nodes) | + (edge_data$edge_type == "timepoint_precedes" & edge_data$from %in% kept_nodes & edge_data$to %in% kept_nodes) + + new_nodes <- node_data[node_data$node_id %in% kept_nodes, , drop = FALSE] + new_edges <- edge_data[keep_edge, , drop = FALSE] + row.names(new_nodes) <- NULL + row.names(new_edges) <- NULL + + .depgraph_rebuild( + new_nodes, new_edges, graph$metadata, + graph_name = graph_name %||% graph$metadata$graph_name, + dataset_name = dataset_name %||% graph$metadata$dataset_name, + validate = validate, + extra_metadata = list( + subset_of = graph$metadata$graph_name, + n_samples_before_subset = length(all_samples) + ) + ) +} + +#' @rdname graph_edit +#' @export +combine_graphs <- function(..., graph_name = NULL, dataset_name = NULL, validate = TRUE) { + graphs <- list(...) + if (length(graphs) == 1L && is.list(graphs[[1L]]) && !inherits(graphs[[1L]], "dependency_graph")) { + graphs <- graphs[[1L]] + } + .depgraph_assert(length(graphs) >= 2L, "`combine_graphs()` needs at least two graphs.") + for (g in graphs) { + .depgraph_assert(inherits(g, "dependency_graph"), "Every argument to `combine_graphs()` must be a `dependency_graph`.") + } + + node_data <- .depgraph_dedupe_nodes(do.call(rbind, lapply(graphs, function(g) g$nodes$data))) + edge_data <- .depgraph_dedupe_edges(do.call(rbind, lapply(graphs, function(g) g$edges$data))) + edge_data <- .depgraph_renumber_edge_ids(edge_data) + + merged_overrides <- list() + merged_sources <- list() + first_name <- NULL + first_dataset <- NULL + for (g in graphs) { + merged_overrides <- utils::modifyList(merged_overrides, g$metadata$validation_overrides %||% list()) + merged_sources <- utils::modifyList(merged_sources, g$metadata$edge_sources %||% list()) + if (is.null(first_name)) first_name <- g$metadata$graph_name + if (is.null(first_dataset)) first_dataset <- g$metadata$dataset_name + } + + .depgraph_rebuild( + node_data, edge_data, + metadata = list(validation_overrides = merged_overrides, edge_sources = merged_sources), + graph_name = graph_name %||% first_name, + dataset_name = dataset_name %||% first_dataset, + validate = validate, + extra_metadata = list( + combined_from = vapply(graphs, function(g) g$metadata$graph_name %||% NA_character_, character(1)) + ) + ) +} + +#' @rdname graph_edit +#' @export +add_edges <- function(graph, edges, graph_name = NULL, dataset_name = NULL, validate = TRUE) { + .depgraph_assert(inherits(graph, "dependency_graph"), "`graph` must be a `dependency_graph`.") + if (inherits(edges, "graph_edge_set")) edges <- list(edges) + .depgraph_assert( + is.list(edges) && length(edges) > 0L && all(vapply(edges, inherits, logical(1), what = "graph_edge_set")), + "`edges` must be a `graph_edge_set` or a list of them." + ) + + existing <- graph$edges$data + incoming <- .depgraph_bind_data(edges, "data") + # An empty edge set is legitimate (e.g. no pair passed a threshold): the + # graph is unchanged except for the recorded provenance. + incoming$edge_id <- rep(NA_character_, nrow(incoming)) + combined <- .depgraph_dedupe_edges(rbind(existing, incoming)) + # Rows that survived dedupe but came from `incoming` have NA ids; number them + # after the highest existing index of their type. + combined <- .depgraph_renumber_edge_ids(combined, reserve = existing$edge_id) + + added_sources <- .depgraph_collect_edge_sources(edges) + metadata <- graph$metadata + metadata$edge_sources <- utils::modifyList(metadata$edge_sources %||% list(), added_sources) + + out <- .depgraph_rebuild( + graph$nodes$data, combined, metadata, + graph_name = graph_name %||% graph$metadata$graph_name, + dataset_name = dataset_name %||% graph$metadata$dataset_name, + validate = validate + ) + # `.depgraph_rebuild()` keeps provenance only for relations that have edges; + # an edge set that added nothing (no pair passed its threshold) must still + # leave its threshold on record, so re-attach the sources just added. + out$metadata$edge_sources <- utils::modifyList(out$metadata$edge_sources %||% list(), added_sources) + out +} diff --git a/R/ingest.R b/R/ingest.R index 3c7ad82..8bec1a1 100644 --- a/R/ingest.R +++ b/R/ingest.R @@ -46,7 +46,8 @@ ingest_metadata <- function(data, col_map = NULL, dataset_name = NULL, strict = names(out), c( "sample_id", "subject_id", "batch_id", "study_id", - "timepoint_id", "assay_id", "featureset_id", "outcome_id" + "timepoint_id", "assay_id", "featureset_id", "outcome_id", + "site_id", "region_id", "platform_id" ) ) @@ -121,23 +122,31 @@ create_nodes <- function(data, type, id_col, label_col = NULL, attr_cols = NULL, keep_cols <- unique(c(id_col, label_col, attr_cols)) keep_cols <- keep_cols[!is.na(keep_cols) & nzchar(keep_cols)] selected <- data[, keep_cols, drop = FALSE] + # Coerce the identifier column up front so factor / numeric identifiers + # behave like character ones (`nzchar()` rejects factors outright). + selected[[id_col]] <- as.character(selected[[id_col]]) selected <- selected[!is.na(selected[[id_col]]) & nzchar(selected[[id_col]]), , drop = FALSE] if (isTRUE(dedupe) && anyDuplicated(selected[[id_col]]) > 0L) { - dup_ids <- unique(selected[[id_col]][duplicated(selected[[id_col]])]) - dup_rows <- selected[selected[[id_col]] %in% dup_ids, , drop = FALSE] - conflicting_ids <- dup_ids[vapply(dup_ids, function(dup_id) { - id_rows <- selected[selected[[id_col]] == dup_id, , drop = FALSE] - nrow(unique(id_rows)) > 1L - }, logical(1))] + # An identifier conflicts when it survives row-deduplication more than + # once, i.e. it appears with two different attribute rows. One pass over + # the unique rows, instead of one table scan per duplicated id. With only + # the id column present no two rows for one id can differ, so skip it. + conflicting_ids <- character() + if (ncol(selected) > 1L) { + distinct_rows <- unique(selected) + distinct_ids <- distinct_rows[[id_col]] + conflicting_ids <- unique(distinct_ids[duplicated(distinct_ids)]) + } if (length(conflicting_ids) > 0L) { - stop( + .depgraph_stop( paste0( "Conflicting node definitions found for IDs: ", paste(conflicting_ids, collapse = ", ") ), - call. = FALSE + class = "splitgraph_ambiguity_error", + code = "conflicting_node_definitions" ) } selected <- selected[!duplicated(selected[[id_col]]), , drop = FALSE] @@ -163,7 +172,9 @@ create_nodes <- function(data, type, id_col, label_col = NULL, attr_cols = NULL, #' @rdname create_nodes #' @export -create_edges <- function(data, from_col, to_col, from_type, to_type, relation, attr_cols = NULL, allow_missing = FALSE, dedupe = TRUE, from_prefix = TRUE, to_prefix = TRUE) { +create_edges <- function(data, from_col, to_col, from_type, to_type, relation, + attr_cols = NULL, allow_missing = FALSE, dedupe = TRUE, + from_prefix = TRUE, to_prefix = TRUE) { .depgraph_assert(is.data.frame(data), "`data` must be a data.frame.") .depgraph_assert(from_col %in% names(data), paste0("Missing `from_col`: ", from_col)) .depgraph_assert(to_col %in% names(data), paste0("Missing `to_col`: ", to_col)) @@ -176,7 +187,8 @@ create_edges <- function(data, from_col, to_col, from_type, to_type, relation, a if (nrow(schema_row) == 1L) { .depgraph_assert( identical(schema_row$from_type[[1L]], from_type) && identical(schema_row$to_type[[1L]], to_type), - paste0("Relation `", relation, "` expects ", schema_row$from_type[[1L]], " -> ", schema_row$to_type[[1L]], ".") + paste0("Relation `", relation, "` expects ", schema_row$from_type[[1L]], " -> ", schema_row$to_type[[1L]], "."), + class = "splitgraph_schema_error", code = "invalid_edge_signature" ) } @@ -191,7 +203,10 @@ create_edges <- function(data, from_col, to_col, from_type, to_type, relation, a if (isTRUE(allow_missing)) { selected <- selected[!missing_endpoint, , drop = FALSE] } else { - stop("Missing endpoint values found while creating edges.", call. = FALSE) + .depgraph_stop( + "Missing endpoint values found while creating edges.", + class = "splitgraph_reference_error", code = "missing_edge_endpoint" + ) } } @@ -221,12 +236,13 @@ create_edges <- function(data, from_col, to_col, from_type, to_type, relation, a parts <- strsplit(edge_key, "\r", fixed = TRUE)[[1L]] paste0(parts[[1L]], " -> ", parts[[2L]], " [", parts[[3L]], "]") }, character(1)) - stop( + .depgraph_stop( paste0( "Conflicting edge definitions found for relations: ", paste(conflicting_labels, collapse = ", ") ), - call. = FALSE + class = "splitgraph_ambiguity_error", + code = "conflicting_edge_definitions" ) } diff --git a/R/methods.R b/R/methods.R index f39ecdc..473121f 100644 --- a/R/methods.R +++ b/R/methods.R @@ -141,23 +141,106 @@ summary.dependency_graph <- function(object, ...) { unname(colors) } +# The igraph object to draw for a given focus. "full" is the typed graph; +# "sample_projection" is the undirected sample graph whose edges join samples +# that share a dependency target (via `detect_dependency_components()`); "ego" +# is the neighbourhood of one node. +.depgraph_plot_graph <- function(x, focus, node = NULL, via = NULL, order = 1L) { + if (identical(focus, "full")) { + return(x$graph) + } + + if (identical(focus, "ego")) { + .depgraph_assert(!is.null(node), "`node` is required when `focus = \"ego\"`.") + node_id <- .depgraph_resolve_node_ids(x, node)[[1L]] + return(igraph::make_ego_graph(x$graph, order = order, nodes = node_id, mode = "all")[[1L]]) + } + + via <- via %||% c("Subject", "Batch", "Study", "Timepoint") + components <- detect_dependency_components(x, via = via, min_size = 1) + projection <- components$metadata$projection_edges + samples <- x$nodes$data[x$nodes$data$node_type == "Sample", , drop = FALSE] + edges <- if (nrow(projection) == 0L) { + data.frame(from = character(), to = character(), stringsAsFactors = FALSE) + } else { + data.frame(from = projection$sample_node_id_1, to = projection$sample_node_id_2, stringsAsFactors = FALSE) + } + igraph::graph_from_data_frame( + d = edges, + vertices = data.frame( + name = samples$node_id, + node_type = "Sample", + node_key = samples$node_key, + label = samples$label, + stringsAsFactors = FALSE + ), + directed = FALSE + ) +} + +#' Plot a Dependency Graph +#' +#' Draw a \code{dependency_graph} with node colours by type and, by default, a +#' layered layout that places samples on the bottom row and their dependency +#' targets above them. +#' +#' @param x A \code{dependency_graph}. +#' @param layout \code{"typed"} (one row per node-type layer), +#' \code{"sugiyama"} (igraph's layered layout), \code{"auto"} (igraph's +#' default), a layout matrix, or a function of the igraph object returning +#' one. For \code{focus = "sample_projection"} the typed layout is replaced by +#' a force-directed one, since every node is a sample. +#' @param focus What to draw. \code{"full"} (default) draws the typed graph. +#' \code{"sample_projection"} draws only the \code{Sample} nodes, joined when +#' they share a dependency target of a type in \code{via}: the picture of the +#' grouping that \code{derive_split_constraints(mode = "composite")} would +#' produce. \code{"ego"} draws the neighbourhood of \code{node} up to +#' \code{order} steps in either direction. +#' @param node For \code{focus = "ego"}: the node id (e.g. \code{"sample:S1"}) +#' at the centre of the neighbourhood. +#' @param via For \code{focus = "sample_projection"}: dependency node types +#' that link samples. Defaults to Subject, Batch, Study, Timepoint. +#' @param order For \code{focus = "ego"}: neighbourhood radius in edges. +#' @param node_colors Optional named vector overriding the type palette. +#' @param show_labels Draw node labels. +#' @param legend,legend_position Draw a node-type legend and where. +#' @param ... Further arguments passed to \code{igraph}'s plot method. +#' @return \code{x}, invisibly. Called for the plot. +#' @examples +#' meta <- data.frame( +#' sample_id = c("S1", "S2", "S3"), subject_id = c("P1", "P1", "P2"), +#' batch_id = c("B1", "B2", "B1") +#' ) +#' g <- graph_from_metadata(meta) +#' plot(g) +#' plot(g, focus = "sample_projection", via = "Subject") +#' plot(g, focus = "ego", node = "subject:P1") #' @export plot.dependency_graph <- function(x, layout = c("typed", "sugiyama", "auto"), + focus = c("full", "sample_projection", "ego"), + node = NULL, + via = NULL, + order = 1L, node_colors = NULL, show_labels = TRUE, legend = TRUE, legend_position = "topleft", ...) { - layout_choice <- if (is.character(layout)) match.arg(layout) else layout - g <- x$graph + layout_choice <- if (is.character(layout)) .depgraph_match_arg(layout, c("typed", "sugiyama", "auto"), "layout") else layout + focus <- .depgraph_match_arg(focus, c("full", "sample_projection", "ego"), "focus") + g <- .depgraph_plot_graph(x, focus, node = node, via = via, order = order) user_args <- list(...) plot_args <- list(x = g) if (is.character(layout_choice)) { if (identical(layout_choice, "typed")) { - plot_args$layout <- .depgraph_typed_layout(g) + plot_args$layout <- if (identical(focus, "sample_projection")) { + igraph::layout_with_fr(g) + } else { + .depgraph_typed_layout(g) + } } else if (identical(layout_choice, "sugiyama")) { plot_args$layout <- igraph::layout_with_sugiyama(g)$layout } @@ -238,31 +321,6 @@ as.data.frame.graph_query_result <- function(x, row.names = NULL, optional = FAL x$table } -#' @export -print.dependency_constraint <- function(x, ...) { - cat("", x$constraint_id, "\n") - cat(" Samples:", nrow(x$sample_map), "\n") - invisible(x) -} - -#' @export -summary.dependency_constraint <- function(object, ...) { - group_col <- intersect(c("group_id", "split_unit", "block_id"), names(object$sample_map)) - n_groups <- if (length(group_col) == 0L) NA_integer_ else length(unique(object$sample_map[[group_col[[1L]]]])) - list( - constraint_id = object$constraint_id, - relation_types = object$relation_types, - n_samples = nrow(object$sample_map), - n_groups = n_groups, - transitive = object$transitive - ) -} - -#' @export -as.data.frame.dependency_constraint <- function(x, row.names = NULL, optional = FALSE, ...) { - x$sample_map -} - #' @export print.split_constraint <- function(x, ...) { cat("", x$strategy, "\n") @@ -332,6 +390,15 @@ print.split_spec <- function(x, ...) { cat("", x$constraint_mode %||% "", "\n") cat(" Samples:", nrow(x$sample_data), "\n") cat(" Groups:", length(unique(x$sample_data[[x$group_var]])), "\n") + if (length(x$block_vars) > 0L) { + cat(" Block vars:", paste(x$block_vars, collapse = ", "), "\n") + } + if (!is.null(x$time_var)) { + cat(" Time var:", x$time_var, if (isTRUE(x$ordering_required)) "(ordering required)" else "", "\n") + } + if (!is.null(x$stratum_var)) { + cat(" Stratum var:", x$stratum_var, "\n") + } if (!is.null(x$recommended_resampling)) { cat(" Recommended resampling:", x$recommended_resampling, "\n") } @@ -347,6 +414,7 @@ summary.split_spec <- function(object, ...) { n_groups = length(unique(object$sample_data[[object$group_var]])), block_vars = object$block_vars, time_var = object$time_var, + stratum_var = object$stratum_var, ordering_required = object$ordering_required, recommended_resampling = object$recommended_resampling ) @@ -398,6 +466,10 @@ as.data.frame.leakage_risk_summary <- function(x, row.names = NULL, optional = F x$diagnostics } +# NOTE: this is deliberately NOT base R's `%||%` (R >= 4.4), which only tests +# for NULL. splitGraph's variant also treats a zero-length vector and a single +# NA as "missing", because JSON round-trips turn absent fields into NA and +# metadata fields into empty vectors. Do not "simplify" it to the base version. `%||%` <- function(x, y) { if (is.null(x) || length(x) == 0L || (length(x) == 1L && is.na(x))) { return(y) diff --git a/R/pairwise.R b/R/pairwise.R index fd680e6..a20737f 100644 --- a/R/pairwise.R +++ b/R/pairwise.R @@ -12,21 +12,16 @@ spatial = "sample_adjacent_to" ) -# Build sample-sample projection edges for a pairwise mode, restricted to the -# in-scope sample node ids. For "spatial" the graph already carries -# sample-sample edges. For "relatedness" the graph carries subject-subject -# edges, so we expand them onto samples: two samples are linked when they share -# a subject (same individual) or when their subjects are directly related. -.depgraph_pairwise_projection_edges <- function(graph, mode, sample_node_ids) { +# Edges that connect in-scope samples for a pairwise mode, in a form +# `.depgraph_sample_components()` can consume without enumerating sample pairs: +# spatial -> sample_adjacent_to edges among in-scope samples; +# relatedness -> sample -> subject edges for in-scope samples plus the +# subject_related_to edges (samples of related subjects, and +# samples of the same subject, then fall into one component). +.depgraph_pairwise_component_edges <- function(graph, mode, sample_node_ids) { relation <- .depgraph_pairwise_relation[[mode]] edge_data <- graph$edges$data - empty <- data.frame( - sample_node_id_1 = character(), - sample_node_id_2 = character(), - stringsAsFactors = FALSE - ) - if (identical(mode, "spatial")) { e <- edge_data[ edge_data$edge_type == relation & @@ -35,56 +30,24 @@ c("from", "to"), drop = FALSE ] - if (nrow(e) == 0L) return(empty) - return(unique(data.frame( - sample_node_id_1 = e$from, - sample_node_id_2 = e$to, - stringsAsFactors = FALSE - ))) + row.names(e) <- NULL + return(e) } - # relatedness: sample -> subject for in-scope samples. belongs <- edge_data[ - edge_data$edge_type == "sample_belongs_to_subject" & - edge_data$from %in% sample_node_ids, + edge_data$edge_type == "sample_belongs_to_subject" & edge_data$from %in% sample_node_ids, c("from", "to"), drop = FALSE ] - if (nrow(belongs) == 0L) return(empty) - - samples_of_subject <- split(belongs$from, belongs$to) - parts <- list() - - # within-subject: samples from the same individual are always grouped. - for (subject in names(samples_of_subject)) { - s <- unique(samples_of_subject[[subject]]) - if (length(s) >= 2L) { - cmb <- utils::combn(s, 2L) - parts[[length(parts) + 1L]] <- data.frame( - sample_node_id_1 = cmb[1L, ], - sample_node_id_2 = cmb[2L, ], - stringsAsFactors = FALSE - ) - } - } - - # across related subjects (undirected subject_related_to edges). - rel_edges <- edge_data[edge_data$edge_type == relation, c("from", "to"), drop = FALSE] - for (i in seq_len(nrow(rel_edges))) { - sa <- samples_of_subject[[rel_edges$from[[i]]]] - sb <- samples_of_subject[[rel_edges$to[[i]]]] - if (length(sa) > 0L && length(sb) > 0L) { - grid <- expand.grid(a = sa, b = sb, KEEP.OUT.ATTRS = FALSE, stringsAsFactors = FALSE) - parts[[length(parts) + 1L]] <- data.frame( - sample_node_id_1 = grid$a, - sample_node_id_2 = grid$b, - stringsAsFactors = FALSE - ) - } - } - - if (length(parts) == 0L) return(empty) - unique(do.call(rbind, parts)) + related <- edge_data[edge_data$edge_type == relation, c("from", "to"), drop = FALSE] + # Keep only relatedness edges whose BOTH subjects carry in-scope samples. A + # subject with no in-scope samples must not act as a bridge (P1 ~ P2 ~ P3 with + # P2 sample-less does not group P1's and P3's samples), matching the pairwise + # semantics the mode has always had and the subset rule used by composite mode. + related <- related[related$from %in% belongs$to & related$to %in% belongs$to, , drop = FALSE] + e <- rbind(belongs, related) + row.names(e) <- NULL + e } .derive_pairwise_constraints <- function(graph, mode, samples = NULL) { @@ -92,26 +55,10 @@ sample_nodes <- .depgraph_constraint_samples(graph, samples) keep_ids <- sample_nodes$node_id - projection <- .depgraph_pairwise_projection_edges(graph, mode, keep_ids) - - subset_graph <- if (nrow(projection) == 0L) { - igraph::make_empty_graph(n = length(keep_ids), directed = FALSE) - } else { - igraph::graph_from_data_frame( - d = data.frame( - from = projection$sample_node_id_1, - to = projection$sample_node_id_2, - stringsAsFactors = FALSE - ), - vertices = data.frame(name = keep_ids, stringsAsFactors = FALSE), - directed = FALSE - ) - } - igraph::V(subset_graph)$name <- keep_ids - - comps <- igraph::components(subset_graph) - membership_idx <- as.integer(comps$membership[keep_ids]) - component_size <- as.integer(comps$csize[membership_idx]) + component_edges <- .depgraph_pairwise_component_edges(graph, mode, keep_ids) + comps <- .depgraph_sample_components(keep_ids, component_edges) + membership_idx <- comps$membership + component_size <- comps$size sample_map <- data.frame( sample_id = sample_nodes$node_key, @@ -129,12 +76,10 @@ warnings <- character() if (identical(mode, "relatedness")) { - linked_samples <- unique(c(projection$sample_node_id_1, projection$sample_node_id_2)) - without_subject <- setdiff( + missing_subject <- setdiff( keep_ids, graph$edges$data$from[graph$edges$data$edge_type == "sample_belongs_to_subject"] ) - missing_subject <- intersect(keep_ids, without_subject) if (length(missing_subject) > 0L) { warnings <- c(warnings, paste0( "Samples without a subject assignment were retained as singleton groups ", @@ -165,8 +110,10 @@ relations_used = relation, n_groups = length(unique(sample_map$group_id)), n_samples = nrow(sample_map), - warnings = warnings, - projection_edges = projection + n_dependency_edges = nrow(component_edges), + threshold = as.numeric(graph$metadata$edge_sources[[relation]]$threshold %||% NA_real_), + threshold_metric = as.character(graph$metadata$edge_sources[[relation]]$metric %||% NA_character_), + warnings = warnings ) ) } @@ -193,8 +140,11 @@ #' and edge sets in \code{build_dependency_graph()}. The passing metric value is #' carried on each edge as an attribute (\code{kinship} / \code{distance}). #' -#' @param pairs A data.frame of subject pairs with two id columns and a metric -#' column. +#' @param pairs Either a data.frame of subject pairs with two id columns and a +#' metric column (the long format written by KING, GCTA, and most kinship +#' tools), or a square symmetric numeric matrix whose row names are subject +#' ids (e.g. PLINK \code{--make-rel square} output); a matrix is expanded to +#' its upper-triangle pairs before thresholding. #' @param threshold Minimum kinship value (inclusive) for a pair to be kept. #' @param id1,id2 Column names in \code{pairs} holding the two subject ids. #' @param kinship Column name in \code{pairs} holding the kinship / relatedness @@ -223,7 +173,10 @@ #' @name pairwise_edges #' @export relatedness_edges_from_kinship <- function(pairs, threshold, id1 = "id1", id2 = "id2", kinship = "kinship") { - .depgraph_assert(is.data.frame(pairs), "`pairs` must be a data.frame.") + if (is.matrix(pairs)) { + pairs <- .depgraph_kinship_matrix_to_pairs(pairs, id1 = id1, id2 = id2, kinship = kinship) + } + .depgraph_assert(is.data.frame(pairs), "`pairs` must be a data.frame or a square kinship matrix.") .depgraph_assert(length(threshold) == 1L && is.numeric(threshold) && !is.na(threshold), "`threshold` must be a single numeric value.") for (col in c(id1, id2, kinship)) { @@ -241,15 +194,54 @@ relatedness_edges_from_kinship <- function(pairs, threshold, id1 = "id1", id2 = kinship = value[keep], stringsAsFactors = FALSE ) - if (nrow(kept) == 0L) return(graph_edge_set()) + out <- if (nrow(kept) == 0L) { + graph_edge_set(source = list(relation = "subject_related_to", from_col = "from_id", to_col = "to_id")) + } else { + create_edges( + kept, + from_col = "from_id", to_col = "to_id", + from_type = "Subject", to_type = "Subject", + relation = "subject_related_to", + attr_cols = "kinship" + ) + } + # Record the threshold on the edge set so the graph (and any derived + # split_spec) can report the provenance of the grouping. + out$source$threshold <- as.numeric(threshold) + out$source$metric <- "kinship" + out +} - create_edges( - kept, - from_col = "from_id", to_col = "to_id", - from_type = "Subject", to_type = "Subject", - relation = "subject_related_to", - attr_cols = "kinship" +# Convert a square, symmetric kinship / GRM matrix with subject ids as dimnames +# (e.g. PLINK `--make-rel square`) into the long pair table the edge builder +# consumes: one row per unordered pair from the upper triangle. +.depgraph_kinship_matrix_to_pairs <- function(mat, id1, id2, kinship) { + .depgraph_assert( + is.numeric(mat) && nrow(mat) == ncol(mat), + "A kinship matrix must be square and numeric." + ) + ids <- rownames(mat) %||% colnames(mat) + .depgraph_assert( + !is.null(ids) && length(ids) == nrow(mat) && all(nzchar(ids)), + "A kinship matrix must carry subject ids as row (or column) names." ) + if (!is.null(colnames(mat)) && !identical(colnames(mat), ids)) { + .depgraph_assert( + setequal(colnames(mat), ids), + "Row and column names of a kinship matrix must refer to the same subjects." + ) + mat <- mat[, ids, drop = FALSE] + } + hit <- which(upper.tri(mat), arr.ind = TRUE) + hit <- hit[order(hit[, 1L], hit[, 2L]), , drop = FALSE] + out <- data.frame( + ids[hit[, 1L]], + ids[hit[, 2L]], + mat[hit], + stringsAsFactors = FALSE + ) + names(out) <- c(id1, id2, kinship) + out } #' @rdname pairwise_edges @@ -283,28 +275,37 @@ spatial_edges_from_coords <- function(coords, radius, id = "sample_id", coord_co kept <- if (n < 2L) { empty } else { + # Vectorised upper-triangle scan. `which()` drops NA distances; rows are + # ordered (i, j) row-major to match the historical edge numbering. dmat <- as.matrix(stats::dist(mat)) - rows <- list() - for (i in seq_len(n - 1L)) { - for (j in seq(i + 1L, n)) { - d <- dmat[i, j] - if (!is.na(d) && d <= radius && ids[[i]] != ids[[j]]) { - rows[[length(rows) + 1L]] <- data.frame( - from_id = ids[[i]], to_id = ids[[j]], distance = d, - stringsAsFactors = FALSE - ) - } - } + hit <- which(dmat <= radius & upper.tri(dmat), arr.ind = TRUE) + if (nrow(hit) == 0L) { + empty + } else { + hit <- hit[order(hit[, 1L], hit[, 2L]), , drop = FALSE] + i <- hit[, 1L] + j <- hit[, 2L] + keep <- ids[i] != ids[j] + data.frame( + from_id = ids[i][keep], + to_id = ids[j][keep], + distance = dmat[hit][keep], + stringsAsFactors = FALSE + ) } - if (length(rows) == 0L) empty else do.call(rbind, rows) } - if (nrow(kept) == 0L) return(graph_edge_set()) - - create_edges( - kept, - from_col = "from_id", to_col = "to_id", - from_type = "Sample", to_type = "Sample", - relation = "sample_adjacent_to", - attr_cols = "distance" - ) + out <- if (nrow(kept) == 0L) { + graph_edge_set(source = list(relation = "sample_adjacent_to", from_col = "from_id", to_col = "to_id")) + } else { + create_edges( + kept, + from_col = "from_id", to_col = "to_id", + from_type = "Sample", to_type = "Sample", + relation = "sample_adjacent_to", + attr_cols = "distance" + ) + } + out$source$threshold <- as.numeric(radius) + out$source$metric <- "distance" + out } diff --git a/R/query.R b/R/query.R index 7268a0b..7367db8 100644 --- a/R/query.R +++ b/R/query.R @@ -8,13 +8,13 @@ return(.depgraph_default_path_cap) } if (length(max_length) != 1L || !is.numeric(max_length)) { - stop("`max_length` must be a single numeric value, Inf, or NULL.", call. = FALSE) + .depgraph_stop("`max_length` must be a single numeric value, Inf, or NULL.") } if (is.infinite(max_length)) { return(-1) } if (is.na(max_length) || max_length < 0) { - stop("`max_length` must be non-negative.", call. = FALSE) + .depgraph_stop("`max_length` must be non-negative.") } as.integer(max_length) } @@ -25,7 +25,8 @@ .depgraph_assert(length(node_ids) > 0L, "`node_ids` must contain at least one value.") .depgraph_assert( all(node_ids %in% node_data$node_id), - paste0("Unknown node IDs: ", paste(setdiff(node_ids, node_data$node_id), collapse = ", ")) + paste0("Unknown node IDs: ", paste(setdiff(node_ids, node_data$node_id), collapse = ", ")), + class = "splitgraph_reference_error", code = "unknown_node_ids" ) node_ids } @@ -41,7 +42,8 @@ unknown <- setdiff(samples, valid_inputs) .depgraph_assert( length(unknown) == 0L, - paste0("Unknown sample IDs: ", paste(unknown, collapse = ", ")) + paste0("Unknown sample IDs: ", paste(unknown, collapse = ", ")), + class = "splitgraph_reference_error", code = "unknown_sample_ids" ) matched <- sample_nodes$node_id[sample_nodes$node_id %in% samples] @@ -197,108 +199,145 @@ ] } -.depgraph_shared_dependency_table <- function(graph, via, samples = NULL, edge_types = NULL) { - node_data <- graph$nodes$data - edge_data <- graph$edges$data - sample_nodes <- .depgraph_resolve_sample_node_ids(graph, samples) - selected_edge_types <- .depgraph_edge_types_for_via(via, edge_types) +.depgraph_empty_shared_table <- function() { + data.frame( + sample_id_1 = character(), + sample_id_2 = character(), + sample_node_id_1 = character(), + sample_node_id_2 = character(), + shared_node_id = character(), + shared_node_type = character(), + edge_type = character(), + stringsAsFactors = FALSE + ) +} +.depgraph_empty_projection <- function() { + data.frame( + sample_node_id_1 = character(), + sample_node_id_2 = character(), + projection_edge_id = character(), + stringsAsFactors = FALSE + ) +} + +# Sample -> dependency-target edges of the selected relation types, restricted to +# the given sample node ids. Shared by the pair table and the component search. +.depgraph_dependency_edges <- function(graph, sample_node_ids, edge_types) { + edge_data <- graph$edges$data edges <- edge_data[ - edge_data$edge_type %in% selected_edge_types & - edge_data$from %in% sample_nodes, - , + edge_data$edge_type %in% edge_types & edge_data$from %in% sample_node_ids, + c("from", "to", "edge_type"), drop = FALSE ] + edges <- unique(edges) + row.names(edges) <- NULL + edges +} - rows <- list() - row_idx <- 1L - sample_key_map <- stats::setNames(node_data$node_key, node_data$node_id) - node_type_map <- stats::setNames(node_data$node_type, node_data$node_id) +# One row per unordered sample pair that shares a dependency target through one +# relation type. Vectorised as a self-merge on (target, edge_type); the number of +# rows is inherently sum over targets of choose(k, 2), so callers that only need +# the *grouping* should use `.depgraph_sample_components()` instead. +.depgraph_shared_dependency_table <- function(graph, via, samples = NULL, edge_types = NULL) { + node_data <- graph$nodes$data + sample_nodes <- .depgraph_resolve_sample_node_ids(graph, samples) + selected_edge_types <- .depgraph_edge_types_for_via(via, edge_types) + edges <- .depgraph_dependency_edges(graph, sample_nodes, selected_edge_types) if (nrow(edges) == 0L) { - return(data.frame( - sample_id_1 = character(), - sample_id_2 = character(), - sample_node_id_1 = character(), - sample_node_id_2 = character(), - shared_node_id = character(), - shared_node_type = character(), - edge_type = character(), - stringsAsFactors = FALSE - )) + return(.depgraph_empty_shared_table()) } - split_targets <- split(edges, list(edges$to, edges$edge_type), drop = TRUE) - for (group in split_targets) { - sample_group <- sort(unique(group$from)) - if (length(sample_group) < 2L) { - next - } - - pairs <- utils::combn(sample_group, 2L, simplify = FALSE) - for (pair in pairs) { - rows[[row_idx]] <- data.frame( - sample_id_1 = sample_key_map[[pair[[1L]]]], - sample_id_2 = sample_key_map[[pair[[2L]]]], - sample_node_id_1 = pair[[1L]], - sample_node_id_2 = pair[[2L]], - shared_node_id = group$to[[1L]], - shared_node_type = node_type_map[[group$to[[1L]]]], - edge_type = group$edge_type[[1L]], - stringsAsFactors = FALSE - ) - row_idx <- row_idx + 1L - } + # Only targets linked to at least two samples can produce a pair. + target_key <- paste(edges$edge_type, edges$to, sep = "\r") + multi <- target_key %in% target_key[duplicated(target_key)] + edges <- edges[multi, , drop = FALSE] + if (nrow(edges) == 0L) { + return(.depgraph_empty_shared_table()) } - if (length(rows) == 0L) { - return(data.frame( - sample_id_1 = character(), - sample_id_2 = character(), - sample_node_id_1 = character(), - sample_node_id_2 = character(), - shared_node_id = character(), - shared_node_type = character(), - edge_type = character(), - stringsAsFactors = FALSE - )) + pairs <- merge(edges, edges, by = c("to", "edge_type"), suffixes = c("_1", "_2")) + pairs <- pairs[pairs$from_1 < pairs$from_2, , drop = FALSE] + if (nrow(pairs) == 0L) { + return(.depgraph_empty_shared_table()) } - out <- do.call(rbind, rows) + key_map <- stats::setNames(node_data$node_key, node_data$node_id) + type_map <- stats::setNames(node_data$node_type, node_data$node_id) + + out <- data.frame( + sample_id_1 = unname(key_map[pairs$from_1]), + sample_id_2 = unname(key_map[pairs$from_2]), + sample_node_id_1 = pairs$from_1, + sample_node_id_2 = pairs$from_2, + shared_node_id = pairs$to, + shared_node_type = unname(type_map[pairs$to]), + edge_type = pairs$edge_type, + stringsAsFactors = FALSE + ) + out <- out[order(out$edge_type, out$shared_node_id, out$sample_node_id_1, out$sample_node_id_2), , drop = FALSE] row.names(out) <- NULL out } -.depgraph_project_sample_dependencies <- function(graph, via, edge_types = NULL) { - shared <- .depgraph_shared_dependency_table(graph, via = via, edge_types = edge_types) +.depgraph_project_sample_dependencies <- function(shared) { if (nrow(shared) == 0L) { - return(shared) + return(.depgraph_empty_projection()) } projection <- unique(shared[, c("sample_node_id_1", "sample_node_id_2"), drop = FALSE]) + row.names(projection) <- NULL projection$projection_edge_id <- paste0("projection_", seq_len(nrow(projection))) projection } +# Edge ids that participate in the shared-dependency table: every edge of a +# listed (edge_type, target) whose source sample appears in some pair. Because a +# sample linked to a multi-sample target always appears in a pair for that +# target, this equals "all edges into targets that produced pairs". .depgraph_shared_dependency_edge_ids <- function(graph, shared_table) { if (nrow(shared_table) == 0L) { return(character()) } edge_data <- graph$edges$data - edge_ids <- character() - for (i in seq_len(nrow(shared_table))) { - relevant_edges <- edge_data[ - edge_data$edge_type == shared_table$edge_type[[i]] & - edge_data$to == shared_table$shared_node_id[[i]] & - edge_data$from %in% c(shared_table$sample_node_id_1[[i]], shared_table$sample_node_id_2[[i]]), - "edge_id", - drop = TRUE - ] - edge_ids <- c(edge_ids, relevant_edges) + involved_samples <- unique(c(shared_table$sample_node_id_1, shared_table$sample_node_id_2)) + target_keys <- unique(paste(shared_table$edge_type, shared_table$shared_node_id, sep = "\r")) + edge_keys <- paste(edge_data$edge_type, edge_data$to, sep = "\r") + keep <- edge_keys %in% target_keys & edge_data$from %in% involved_samples + unique(edge_data$edge_id[keep]) +} + +# Connected components of samples linked through shared targets, computed on the +# bipartite sample-target graph (plus any extra undirected edges, e.g. +# subject_related_to or sample_adjacent_to). Linear in nodes + edges; never +# enumerates sample pairs. Component numbers follow first appearance in +# `sample_node_ids`, matching the numbering igraph produced for the old +# projection graph. +.depgraph_sample_components <- function(sample_node_ids, edges) { + n <- length(sample_node_ids) + if (n == 0L) { + return(list(membership = integer(), size = integer())) } - unique(edge_ids) + if (nrow(edges) == 0L) { + membership <- seq_len(n) + } else { + vertices <- unique(c(sample_node_ids, edges$from, edges$to)) + g <- igraph::graph_from_data_frame( + d = data.frame(from = edges$from, to = edges$to, stringsAsFactors = FALSE), + vertices = data.frame(name = vertices, stringsAsFactors = FALSE), + directed = FALSE + ) + raw <- igraph::components(g)$membership[sample_node_ids] + membership <- match(raw, unique(raw)) + } + + list( + membership = as.integer(membership), + size = as.integer(tabulate(membership)[membership]) + ) } #' Query Dependency Graph Structure @@ -392,7 +431,7 @@ query_edge_type <- function(graph, edge_types, node_ids = NULL) { #' @export query_neighbors <- function(graph, node_ids, edge_types = NULL, node_types = NULL, direction = c("out", "in", "all")) { .depgraph_assert(inherits(graph, "dependency_graph"), "`graph` must be a `dependency_graph`.") - direction <- match.arg(direction) + direction <- .depgraph_match_arg(direction, c("out", "in", "all"), "direction") seed_ids <- .depgraph_resolve_node_ids(graph, node_ids) g <- .depgraph_filter_graph_by_edge_type(graph, edge_types) @@ -473,7 +512,7 @@ query_neighbors <- function(graph, node_ids, edge_types = NULL, node_types = NUL #' @export query_paths <- function(graph, from, to, edge_types = NULL, node_types = NULL, mode = c("out", "in", "all"), max_length = NULL) { .depgraph_assert(inherits(graph, "dependency_graph"), "`graph` must be a `dependency_graph`.") - mode <- match.arg(mode) + mode <- .depgraph_match_arg(mode, c("out", "in", "all"), "mode") from_ids <- .depgraph_resolve_node_ids(graph, from) to_ids <- .depgraph_resolve_node_ids(graph, to) cutoff_value <- .depgraph_resolve_path_cutoff(max_length) @@ -537,7 +576,7 @@ query_paths <- function(graph, from, to, edge_types = NULL, node_types = NULL, m #' @export query_shortest_paths <- function(graph, from, to, edge_types = NULL, node_types = NULL, mode = c("out", "in", "all")) { .depgraph_assert(inherits(graph, "dependency_graph"), "`graph` must be a `dependency_graph`.") - mode <- match.arg(mode) + mode <- .depgraph_match_arg(mode, c("out", "in", "all"), "mode") from_ids <- .depgraph_resolve_node_ids(graph, from) to_ids <- .depgraph_resolve_node_ids(graph, to) filtered_graph <- .depgraph_filter_graph_by_edge_type(graph, edge_types) @@ -584,51 +623,36 @@ query_shortest_paths <- function(graph, from, to, edge_types = NULL, node_types #' @rdname query_node_type #' @export -detect_dependency_components <- function(graph, via = c("Subject", "Batch", "Study", "Timepoint", "Assay", "FeatureSet", "Outcome"), edge_types = NULL, min_size = 1) { +detect_dependency_components <- function(graph, + via = c("Subject", "Batch", "Study", "Timepoint", + "Assay", "FeatureSet", "Outcome"), + edge_types = NULL, min_size = 1) { .depgraph_assert(inherits(graph, "dependency_graph"), "`graph` must be a `dependency_graph`.") - shared <- .depgraph_shared_dependency_table(graph, via = via, edge_types = edge_types) - projection <- .depgraph_project_sample_dependencies(graph, via = via, edge_types = edge_types) sample_nodes <- graph$nodes$data[graph$nodes$data$node_type == "Sample", , drop = FALSE] + selected_edge_types <- .depgraph_edge_types_for_via(via, edge_types) - sample_graph <- if (nrow(projection) == 0L) { - igraph::make_empty_graph(n = nrow(sample_nodes), directed = FALSE) - } else { - g <- igraph::graph_from_data_frame( - d = data.frame( - from = projection$sample_node_id_1, - to = projection$sample_node_id_2, - stringsAsFactors = FALSE - ), - vertices = data.frame(name = sample_nodes$node_id, stringsAsFactors = FALSE), - directed = FALSE - ) - g - } - igraph::V(sample_graph)$name <- sample_nodes$node_id - - components <- igraph::components(sample_graph) + # Grouping first, on the bipartite sample-target graph (linear); the explicit + # pair table below is only materialised for the samples that survive min_size. + dep_edges <- .depgraph_dependency_edges(graph, sample_nodes$node_id, selected_edge_types) + comps <- .depgraph_sample_components(sample_nodes$node_id, dep_edges) table <- data.frame( sample_id = sample_nodes$node_key, sample_node_id = sample_nodes$node_id, - component_id = paste0("component_", components$membership[match(sample_nodes$node_id, names(components$membership))]), - component_size = components$csize[components$membership[match(sample_nodes$node_id, names(components$membership))]], + component_id = paste0("component_", comps$membership), + component_size = comps$size, stringsAsFactors = FALSE ) table <- table[table$component_size >= min_size, , drop = FALSE] + row.names(table) <- NULL keep_nodes <- table$sample_node_id - projection <- projection[ - projection$sample_node_id_1 %in% keep_nodes & - projection$sample_node_id_2 %in% keep_nodes, - , - drop = FALSE - ] - shared <- shared[ - shared$sample_node_id_1 %in% keep_nodes & - shared$sample_node_id_2 %in% keep_nodes, - , - drop = FALSE - ] + + shared <- if (length(keep_nodes) == 0L) { + .depgraph_empty_shared_table() + } else { + .depgraph_shared_dependency_table(graph, via = via, samples = keep_nodes, edge_types = edge_types) + } + projection <- .depgraph_project_sample_dependencies(shared) edge_ids <- .depgraph_shared_dependency_edge_ids(graph, shared) .depgraph_query_result( diff --git a/R/schema-validate.R b/R/schema-validate.R index cd34923..ea351dd 100644 --- a/R/schema-validate.R +++ b/R/schema-validate.R @@ -6,10 +6,12 @@ # a handoff file without pulling in a JSON Schema engine. # Path to a shipped schema file within the installed package (or source tree -# under pkgload). Returns "" if it cannot be located. -.depgraph_schema_path <- function(object_type) { +# under pkgload). Schemas live under a versioned directory so a `$schema` +# reference in a written file stays valid after later schema bumps. Returns "" +# if it cannot be located. +.depgraph_schema_path <- function(object_type, version = .depgraph_schema_version) { file <- paste0(object_type, ".schema.json") - p <- system.file("schema", file, package = "splitGraph") + p <- system.file("schema", version, file, package = "splitGraph") if (nzchar(p)) p else "" } @@ -43,17 +45,34 @@ print.splitgraph_json_report <- function(x, ...) { .depgraph_require_jsonlite() .depgraph_assert(is.character(path) && length(path) == 1L && nzchar(path), "`path` must be a single non-empty file path.") - .depgraph_assert(file.exists(path), paste0("File not found: ", path)) + .depgraph_assert(file.exists(path), paste0("File not found: ", path), + class = "splitgraph_io_error", code = "file_not_found") tryCatch( jsonlite::fromJSON(path, simplifyVector = FALSE), error = function(e) { - stop("Failed to parse JSON at `", path, "`: ", conditionMessage(e), call. = FALSE) + .depgraph_stop( + c("Failed to parse JSON at `", path, "`: ", conditionMessage(e)), + class = "splitgraph_io_error", code = "json_parse_failure" + ) } ) } .depgraph_is_string <- function(x) is.character(x) && length(x) == 1L && !is.na(x) +# A parsed JSON value that is either absent/null or a scalar of the given kind. +.depgraph_is_null_or_string <- function(x) is.null(x) || .depgraph_is_string(x) +.depgraph_is_null_or_number <- function(x) is.null(x) || (is.numeric(x) && length(x) == 1L && !is.na(x)) +.depgraph_is_null_or_integer <- function(x) { + is.null(x) || (is.numeric(x) && length(x) == 1L && !is.na(x) && x == trunc(x)) +} +# JSON objects and arrays both parse to lists, and jsonlite distinguishes them +# by names even when empty: `{}` has `character(0)` names, `[]` has NULL names. +# Testing `!is.null(names(x))` therefore separates them in every case, including +# the empty one (an earlier `length(x) == 0L ||` short-circuit did not). +.depgraph_is_json_object <- function(x) is.list(x) && !is.null(names(x)) +.depgraph_is_json_array <- function(x) is.list(x) && is.null(names(x)) + .depgraph_valid_version <- function(x) { .depgraph_is_string(x) && grepl("^[0-9]+\\.[0-9]+\\.[0-9]+$", x) } @@ -62,7 +81,8 @@ print.splitgraph_json_report <- function(x, ...) { #' #' Check that a JSON file written by \code{write_dependency_graph()} or #' \code{write_split_spec()} conforms to the splitGraph on-disk contract. The -#' formal JSON Schemas (Draft 2020-12) ship in \code{inst/schema/} and are +#' formal JSON Schemas (Draft 2020-12) ship in +#' \code{inst/schema//} and are #' referenced from the written JSON via the \code{$schema} key; these functions #' apply a dependency-free structural check of the same invariants (required #' fields, value types, node/edge-type enumerations, and referential integrity @@ -100,6 +120,17 @@ validate_graph_json <- function(path) { if (!.depgraph_valid_version(parsed$schema_version)) { issues <- c(issues, "`schema_version` must be a \"X.Y.Z\" string.") } + if (!is.null(parsed$metadata)) { + if (!.depgraph_is_json_object(parsed$metadata)) { + issues <- c(issues, "`metadata` must be a JSON object.") + } else { + for (field in c("validation_overrides", "edge_sources")) { + if (!is.null(parsed$metadata[[field]]) && !.depgraph_is_json_object(parsed$metadata[[field]])) { + issues <- c(issues, paste0("metadata.", field, " must be a JSON object.")) + } + } + } + } node_rows <- parsed$nodes edge_rows <- parsed$edges @@ -124,6 +155,9 @@ validate_graph_json <- function(path) { if (!r$node_type %in% .depgraph_node_types) { issues <- c(issues, paste0("node[", i, "]: unknown `node_type` \"", r$node_type, "\".")) } + if (!is.null(r$attrs) && !.depgraph_is_json_object(r$attrs)) { + issues <- c(issues, paste0("node[", i, "]: `attrs` must be a JSON object.")) + } } valid_edge_types <- .depgraph_edge_schema$edge_type @@ -137,6 +171,9 @@ validate_graph_json <- function(path) { if (!r$edge_type %in% valid_edge_types) { issues <- c(issues, paste0("edge[", i, "]: unknown `edge_type` \"", r$edge_type, "\".")) } + if (!is.null(r$attrs) && !.depgraph_is_json_object(r$attrs)) { + issues <- c(issues, paste0("edge[", i, "]: `attrs` must be a JSON object.")) + } if (length(node_ids) > 0L) { if (!r$from %in% node_ids) { issues <- c(issues, paste0("edge[", i, "]: `from` \"", r$from, "\" does not reference a declared node.")) @@ -170,15 +207,44 @@ validate_split_spec_json <- function(path) { if (!.depgraph_is_string(parsed$group_var)) { issues <- c(issues, "`group_var` must be a string.") } - if (!is.null(parsed$block_vars) && !is.list(parsed$block_vars)) { + if (!is.null(parsed$block_vars) && + !(.depgraph_is_json_array(parsed$block_vars) && all(vapply(parsed$block_vars, .depgraph_is_string, logical(1))))) { issues <- c(issues, "`block_vars` must be an array of strings.") } + for (field in c("time_var", "stratum_var", "constraint_mode", "constraint_strategy", "recommended_resampling")) { + if (!.depgraph_is_null_or_string(parsed[[field]])) { + issues <- c(issues, paste0("`", field, "` must be a string or null.")) + } + } + if (!is.null(parsed$ordering_required) && !(is.logical(parsed$ordering_required) && length(parsed$ordering_required) == 1L)) { + issues <- c(issues, "`ordering_required` must be a boolean.") + } + + metadata <- parsed$metadata + if (!is.null(metadata)) { + if (!.depgraph_is_json_object(metadata)) { + issues <- c(issues, "`metadata` must be a JSON object.") + } else { + for (field in .depgraph_split_spec_vector_fields) { + if (!is.null(metadata[[field]]) && !.depgraph_is_json_array(metadata[[field]])) { + issues <- c(issues, paste0("metadata.", field, " must be an array of strings (even with one element).")) + } + } + if (!.depgraph_is_null_or_number(metadata$threshold)) { + issues <- c(issues, "metadata.threshold must be a number or null.") + } + } + } sample_rows <- parsed$sample_data - if (is.null(sample_rows) || !is.list(sample_rows)) { + if (is.null(sample_rows) || !.depgraph_is_json_array(sample_rows)) { issues <- c(issues, "`sample_data` must be an array.") sample_rows <- list() } + string_columns <- c( + "sample_node_id", "primary_group", "batch_group", "study_group", "site_group", + "region_group", "platform_group", "assay_group", "stratum", "timepoint_id" + ) for (i in seq_along(sample_rows)) { r <- sample_rows[[i]] if (!.depgraph_is_string(r$sample_id)) { @@ -187,6 +253,17 @@ validate_split_spec_json <- function(path) { if (!.depgraph_is_string(r$group_id)) { issues <- c(issues, paste0("sample_data[", i, "]: `group_id` is a required string.")) } + for (col in string_columns) { + if (!.depgraph_is_null_or_string(r[[col]])) { + issues <- c(issues, paste0("sample_data[", i, "]: `", col, "` must be a string or null.")) + } + } + if (!.depgraph_is_null_or_number(r$time_index)) { + issues <- c(issues, paste0("sample_data[", i, "]: `time_index` must be a number or null.")) + } + if (!.depgraph_is_null_or_integer(r$order_rank)) { + issues <- c(issues, paste0("sample_data[", i, "]: `order_rank` must be an integer or null.")) + } } .depgraph_json_report("split_spec", path, issues) diff --git a/R/serialization.R b/R/serialization.R index a8545ef..b06ab4a 100644 --- a/R/serialization.R +++ b/R/serialization.R @@ -6,11 +6,10 @@ .depgraph_require_jsonlite <- function() { if (!requireNamespace("jsonlite", quietly = TRUE)) { - stop( + .depgraph_stop(c( "Package 'jsonlite' is required for splitGraph JSON serialization. ", - "Install it with: install.packages(\"jsonlite\").", - call. = FALSE - ) + "Install it with: install.packages(\"jsonlite\")." + )) } invisible(TRUE) } @@ -19,10 +18,9 @@ parent <- dirname(path) if (!nzchar(parent) || identical(parent, ".")) return(invisible()) if (!dir.exists(parent)) { - stop( - "Parent directory does not exist: ", parent, - ". Create it before writing.", - call. = FALSE + .depgraph_stop( + c("Parent directory does not exist: ", parent, ". Create it before writing."), + class = "splitgraph_io_error", code = "missing_parent_directory" ) } invisible() @@ -61,10 +59,10 @@ # Public `$id` of the shipped JSON Schema for an object type, referenced from # written JSON via the `$schema` key so external consumers can locate the # formal contract. Mirrors the file names under `inst/schema/`. -.depgraph_schema_url <- function(object_type) { +.depgraph_schema_url <- function(object_type, version = .depgraph_schema_version) { paste0( "https://raw.githubusercontent.com/selcukorkmaz/splitGraph/main/inst/schema/", - object_type, ".schema.json" + version, "/", object_type, ".schema.json" ) } @@ -76,10 +74,10 @@ .depgraph_check_schema_version <- function(observed, what) { if (is.null(observed) || !nzchar(observed)) { - warning( - "Reading ", what, ": no `schema_version` recorded in JSON. ", - "Assuming current schema (", .depgraph_schema_version, ").", - call. = FALSE + .depgraph_warn( + c("Reading ", what, ": no `schema_version` recorded in JSON. ", + "Assuming current schema (", .depgraph_schema_version, ")."), + code = "missing_schema_version" ) return(invisible()) } @@ -102,12 +100,12 @@ } else { "migrate_dependency_graph_json()" } - warning( - "Reading ", what, ": JSON schema_version `", observed, - "` differs in major version from installed splitGraph schema_version `", - .depgraph_schema_version, "`. Loading anyway; consider `", migrator, - "` to upgrade the file.", - call. = FALSE + .depgraph_warn( + c("Reading ", what, ": JSON schema_version `", observed, + "` differs in major version from installed splitGraph schema_version `", + .depgraph_schema_version, "`. Loading anyway; consider `", migrator, + "` to upgrade the file."), + code = "schema_major_mismatch" ) invisible() } @@ -130,24 +128,36 @@ x } -.depgraph_node_row_to_list <- function(row) { - list( - node_id = row$node_id, - node_type = row$node_type, - node_key = row$node_key, - label = row$label, - attrs = .depgraph_attrs_to_json(row$attrs[[1L]]) +# Table builders for the JSON writers. jsonlite serialises a data frame with +# `dataframe = "rows"` (its default) as an array of row objects; handing it a +# data frame is ~3x faster than building nested R lists, and the emitted text is +# identical. The `attrs` list-column carries one named list per row; an empty +# entry is a *named* empty list so it prints as `{}` (the schema types `attrs` +# as an object), never `[]`. An empty table returns `list()` so it prints `[]`. +.depgraph_node_rows_to_json <- function(node_data) { + if (nrow(node_data) == 0L) return(list()) + out <- data.frame( + node_id = node_data$node_id, + node_type = node_data$node_type, + node_key = node_data$node_key, + label = node_data$label, + stringsAsFactors = FALSE ) + out$attrs <- lapply(node_data$attrs, .depgraph_attrs_to_json) + out } -.depgraph_edge_row_to_list <- function(row) { - list( - edge_id = row$edge_id, - from = row$from, - to = row$to, - edge_type = row$edge_type, - attrs = .depgraph_attrs_to_json(row$attrs[[1L]]) +.depgraph_edge_rows_to_json <- function(edge_data) { + if (nrow(edge_data) == 0L) return(list()) + out <- data.frame( + edge_id = edge_data$edge_id, + from = edge_data$from, + to = edge_data$to, + edge_type = edge_data$edge_type, + stringsAsFactors = FALSE ) + out$attrs <- lapply(edge_data$attrs, .depgraph_attrs_to_json) + out } # Serialize graph metadata, dropping fields that are not portable @@ -158,10 +168,17 @@ dataset_name = metadata$dataset_name %||% NA_character_, created_at = .depgraph_posix_to_iso(metadata$created_at), schema_version = metadata$schema_version %||% .depgraph_schema_version, - validation_overrides = if (is.null(metadata$validation_overrides)) { + # An *unnamed* empty list would serialise as `[]`; the schema declares an + # object, so force the named empty list (`{}`) whenever there is nothing in it. + validation_overrides = if (is.null(metadata$validation_overrides) || length(metadata$validation_overrides) == 0L) { structure(list(), names = character()) } else { as.list(metadata$validation_overrides) + }, + edge_sources = if (is.null(metadata$edge_sources) || length(metadata$edge_sources) == 0L) { + structure(list(), names = character()) + } else { + lapply(metadata$edge_sources, as.list) } ) out @@ -178,6 +195,9 @@ if (!is.null(meta_list$validation_overrides) && length(meta_list$validation_overrides) > 0L) { out$validation_overrides <- as.list(meta_list$validation_overrides) } + if (!is.null(meta_list$edge_sources) && length(meta_list$edge_sources) > 0L) { + out$edge_sources <- lapply(meta_list$edge_sources, as.list) + } out } @@ -200,15 +220,20 @@ #' @section JSON format: #' \preformatted{ #' { -#' "$schema": "https://.../inst/schema/dependency_graph.schema.json", +#' "$schema": "https://.../inst/schema/0.3.0/dependency_graph.schema.json", #' "splitGraph_object": "dependency_graph", -#' "schema_version": "0.2.0", +#' "schema_version": "0.3.0", #' "metadata": { #' "graph_name": "...", #' "dataset_name": "...", #' "created_at": "2026-04-29T10:11:12.000000+0000", -#' "schema_version": "0.2.0", -#' "validation_overrides": { ... } +#' "schema_version": "0.3.0", +#' "validation_overrides": { ... }, +#' "edge_sources": { +#' "subject_related_to": { "relation": "...", "from_col": "...", +#' "to_col": "...", "threshold": 0.125, +#' "metric": "kinship" } +#' } #' }, #' "nodes": [ #' { "node_id": "sample:S1", "node_type": "Sample", @@ -227,17 +252,28 @@ #' version loads silently (additive-only differences); a differing major #' version loads with a warning suggesting \code{migrate_dependency_graph_json()}. #' The written JSON also carries a \code{$schema} reference to the formal JSON -#' Schema shipped in \code{inst/schema/}; validate a file against it with -#' \code{validate_graph_json()}. +#' Schema shipped under \code{inst/schema//}; validate a file +#' against it with \code{validate_graph_json()} or by passing +#' \code{validate = TRUE} when reading. #' #' @param graph A \code{dependency_graph} produced by #' \code{build_dependency_graph()} or \code{graph_from_metadata()}. #' @param path Path to write to or read from. #' @param pretty If \code{TRUE} (default), the JSON is indented for human #' inspection. Set \code{FALSE} for a compact representation. +#' @param validate If \code{TRUE}, check the file against the shipped schema +#' (\code{validate_graph_json()} / \code{validate_split_spec_json()}) before +#' parsing and run \code{validate_graph()} (for graphs) or +#' \code{validate_split_spec()} (for specs) on the result, failing with a +#' classed error on any violation or error-severity issue. The default +#' \code{FALSE} loads the object as written, so a graph saved with +#' \code{validate = FALSE} or predating a validation rule still loads; use +#' \code{validate = TRUE} for files from untrusted or older sources. #' @return \code{write_dependency_graph()} invisibly returns \code{path}. -#' \code{read_dependency_graph()} returns a validated -#' \code{dependency_graph}. +#' \code{read_dependency_graph()} returns a \code{dependency_graph} whose +#' node and edge tables are checked for internal consistency with the +#' rebuilt \code{igraph}; with the default \code{validate = FALSE} it is +#' \emph{not} re-run through \code{validate_graph()}. #' @examples #' if (requireNamespace("jsonlite", quietly = TRUE)) { #' meta <- data.frame( @@ -259,14 +295,8 @@ write_dependency_graph <- function(graph, path, pretty = TRUE) { .depgraph_assert(is.character(path) && length(path) == 1L && nzchar(path), "`path` must be a single non-empty file path.") .depgraph_check_writable_path(path) - node_rows <- if (nrow(graph$nodes$data) == 0L) list() else lapply( - seq_len(nrow(graph$nodes$data)), - function(i) .depgraph_node_row_to_list(graph$nodes$data[i, , drop = FALSE]) - ) - edge_rows <- if (nrow(graph$edges$data) == 0L) list() else lapply( - seq_len(nrow(graph$edges$data)), - function(i) .depgraph_edge_row_to_list(graph$edges$data[i, , drop = FALSE]) - ) + node_rows <- .depgraph_node_rows_to_json(graph$nodes$data) + edge_rows <- .depgraph_edge_rows_to_json(graph$edges$data) payload <- list( `$schema` = .depgraph_schema_url("dependency_graph"), @@ -290,24 +320,24 @@ write_dependency_graph <- function(graph, path, pretty = TRUE) { #' @rdname write_dependency_graph #' @export -read_dependency_graph <- function(path) { +read_dependency_graph <- function(path, validate = FALSE) { .depgraph_require_jsonlite() .depgraph_assert(is.character(path) && length(path) == 1L && nzchar(path), "`path` must be a single non-empty file path.") - .depgraph_assert(file.exists(path), paste0("File not found: ", path)) + .depgraph_assert(file.exists(path), paste0("File not found: ", path), + class = "splitgraph_io_error", code = "file_not_found") - parsed <- tryCatch( - jsonlite::fromJSON(path, simplifyVector = FALSE), - error = function(e) { - stop("Failed to parse JSON at `", path, "`: ", conditionMessage(e), call. = FALSE) - } - ) + if (isTRUE(validate)) { + .depgraph_require_json_conformance(validate_graph_json(path)) + } + + parsed <- .depgraph_parse_json_file(path) obj_type <- parsed$splitGraph_object %||% NA_character_ if (!identical(as.character(obj_type), "dependency_graph")) { - stop( - "JSON at `", path, "` is not a serialized dependency_graph (found `", - obj_type, "`). Use `read_split_spec()` for split_spec files.", - call. = FALSE + .depgraph_stop( + c("JSON at `", path, "` is not a serialized dependency_graph (found `", + obj_type, "`). Use `read_split_spec()` for split_spec files."), + class = "splitgraph_schema_error", code = "unexpected_object_type" ) } @@ -344,52 +374,94 @@ read_dependency_graph <- function(path) { metadata <- .depgraph_metadata_from_json(parsed$metadata) - dependency_graph( + graph <- dependency_graph( nodes = graph_node_set(node_data), edges = graph_edge_set(edge_data), graph = NULL, metadata = metadata ) + + if (isTRUE(validate)) { + validate_graph(graph, error_on_fail = TRUE) + } + + graph +} + +# Turn a failed JSON conformance report into a classed error. +.depgraph_require_json_conformance <- function(report) { + if (isTRUE(report$valid)) return(invisible(report)) + .depgraph_stop( + c( + "JSON at `", report$path, "` does not conform to the ", report$object_type, + " schema (", report$schema, "):\n", + paste0(" - ", report$issues, collapse = "\n") + ), + class = "splitgraph_schema_error", + code = "json_schema_violation" + ) } # ---- Public API: split_spec ------------------------------------------------- -# Convert a split_spec's sample_data row to a JSON-friendly list, preserving -# NA as null in the output stream (na = "null" in toJSON does this for us). -.depgraph_split_spec_row_to_list <- function(row) { - list( - sample_id = row$sample_id, - sample_node_id = row$sample_node_id, - group_id = row$group_id, - primary_group = row$primary_group, - batch_group = row$batch_group, - study_group = row$study_group, - site_group = row$site_group, - region_group = row$region_group, - platform_group = row$platform_group, - assay_group = row$assay_group, - timepoint_id = row$timepoint_id, - time_index = row$time_index, - order_rank = row$order_rank - ) +# The canonical sample_data columns, in on-disk order. +.depgraph_split_spec_columns <- c( + "sample_id", "sample_node_id", "group_id", "primary_group", + "batch_group", "study_group", "site_group", "region_group", + "platform_group", "assay_group", "stratum", "timepoint_id", "time_index", "order_rank" +) + +# split_spec sample_data in canonical column order for the JSON writer. NA is +# preserved as null in the output stream (`na = "null"` in toJSON); columns +# absent from an older object are filled with NA so the on-disk shape is stable. +.depgraph_split_spec_rows_to_json <- function(sample_data) { + if (nrow(sample_data) == 0L) return(list()) + columns <- lapply(.depgraph_split_spec_columns, function(col) { + if (col %in% names(sample_data)) sample_data[[col]] else rep(NA, nrow(sample_data)) + }) + names(columns) <- .depgraph_split_spec_columns + out <- as.data.frame(columns, stringsAsFactors = FALSE, optional = TRUE) + row.names(out) <- NULL + out } +# Metadata fields that are character *vectors* by contract. `toJSON(auto_unbox +# = TRUE)` would collapse a length-1 vector to a bare string, which violates +# the shipped schema (`relations_used` is declared as an array) and makes the +# field's JSON type depend on its length. Wrapping in `as.list()` forces an +# array regardless of length; the reader unlists them back. +.depgraph_split_spec_vector_fields <- c("warnings", "relations_used", "enrichment_warnings", "via", "priority") + .depgraph_metadata_split_spec_to_json <- function(metadata) { - if (is.null(metadata)) return(structure(list(), names = character())) + # An empty (or NULL) metadata list must serialise as `{}`, not `[]`: the + # schema declares an object, and an unnamed empty list would emit an array. + # Reachable for a `split_spec()` built by hand rather than by + # `as_split_spec()`, which always fills metadata. + if (is.null(metadata) || length(metadata) == 0L) return(structure(list(), names = character())) out <- as.list(metadata) + for (k in .depgraph_split_spec_vector_fields) { + if (!is.null(out[[k]])) { + out[[k]] <- as.list(as.character(out[[k]])) + } + } out } .depgraph_metadata_split_spec_from_json <- function(meta_list) { if (is.null(meta_list) || length(meta_list) == 0L) return(list()) out <- as.list(meta_list) - # warnings/relations_used are character vectors; jsonlite keeps them as - # lists when simplifyVector = FALSE — coerce back. - for (k in c("warnings", "relations_used")) { + # warnings/relations_used/enrichment_warnings are character vectors; + # jsonlite keeps them as lists when simplifyVector = FALSE — coerce back. + for (k in .depgraph_split_spec_vector_fields) { if (!is.null(out[[k]])) { out[[k]] <- as.character(unlist(out[[k]])) } } + # Scalar provenance fields written as `null` come back as NULL list + # elements; restore the typed NA the writer started from so a spec + # round-trips its metadata exactly. + if ("threshold" %in% names(out) && is.null(out$threshold)) out$threshold <- NA_real_ + if ("threshold_metric" %in% names(out) && is.null(out$threshold_metric)) out$threshold_metric <- NA_character_ out } @@ -409,27 +481,37 @@ read_dependency_graph <- function(path) { #' @section JSON format: #' \preformatted{ #' { -#' "$schema": "https://.../inst/schema/split_spec.schema.json", +#' "$schema": "https://.../inst/schema/0.3.0/split_spec.schema.json", #' "splitGraph_object": "split_spec", -#' "schema_version": "0.2.0", +#' "schema_version": "0.3.0", #' "group_var": "group_id", #' "block_vars": ["batch_group", "study_group"], #' "time_var": "order_rank", +#' "stratum_var": "stratum", #' "ordering_required": false, #' "constraint_mode": "subject", #' "constraint_strategy": "subject", #' "recommended_resampling": "grouped_cv", -#' "metadata": { ... }, +#' "metadata": { "relations_used": [...], "via": [...], "priority": [...], +#' "threshold": null, "warnings": [...], ... }, #' "sample_data": [ -#' { "sample_id": "S1", "group_id": "subject:P1", ... }, +#' { "sample_id": "S1", "group_id": "subject:P1", "stratum": "case", ... }, #' ... #' ] #' } #' } +#' Vector-valued metadata fields are always written as arrays, even with a +#' single element. \code{stratum_var} and the \code{stratum} column were added +#' in schema 0.3.0; files written by earlier versions load with \code{stratum} +#' filled as \code{NA}. #' #' @param spec A \code{split_spec} produced by \code{as_split_spec()}. #' @param path Path to write to or read from. #' @param pretty If \code{TRUE} (default), the JSON is indented. +#' @param validate If \code{TRUE}, check the file against the shipped schema +#' before parsing and run \code{validate_split_spec()} on the result, failing +#' with a classed error on any violation or error-severity issue. Defaults to +#' \code{FALSE}. #' @return \code{write_split_spec()} invisibly returns \code{path}. #' \code{read_split_spec()} returns a \code{split_spec}. #' @examples @@ -455,10 +537,7 @@ write_split_spec <- function(spec, path, pretty = TRUE) { .depgraph_assert(is.character(path) && length(path) == 1L && nzchar(path), "`path` must be a single non-empty file path.") .depgraph_check_writable_path(path) - sample_rows <- if (nrow(spec$sample_data) == 0L) list() else lapply( - seq_len(nrow(spec$sample_data)), - function(i) .depgraph_split_spec_row_to_list(spec$sample_data[i, , drop = FALSE]) - ) + sample_rows <- .depgraph_split_spec_rows_to_json(spec$sample_data) payload <- list( `$schema` = .depgraph_schema_url("split_spec"), @@ -467,6 +546,7 @@ write_split_spec <- function(spec, path, pretty = TRUE) { group_var = spec$group_var, block_vars = if (length(spec$block_vars) == 0L) list() else as.list(spec$block_vars), time_var = spec$time_var %||% NA_character_, + stratum_var = spec$stratum_var %||% NA_character_, ordering_required = isTRUE(spec$ordering_required), constraint_mode = spec$constraint_mode %||% NA_character_, constraint_strategy = spec$constraint_strategy %||% NA_character_, @@ -488,24 +568,24 @@ write_split_spec <- function(spec, path, pretty = TRUE) { #' @rdname write_split_spec #' @export -read_split_spec <- function(path) { +read_split_spec <- function(path, validate = FALSE) { .depgraph_require_jsonlite() .depgraph_assert(is.character(path) && length(path) == 1L && nzchar(path), "`path` must be a single non-empty file path.") - .depgraph_assert(file.exists(path), paste0("File not found: ", path)) + .depgraph_assert(file.exists(path), paste0("File not found: ", path), + class = "splitgraph_io_error", code = "file_not_found") - parsed <- tryCatch( - jsonlite::fromJSON(path, simplifyVector = FALSE), - error = function(e) { - stop("Failed to parse JSON at `", path, "`: ", conditionMessage(e), call. = FALSE) - } - ) + if (isTRUE(validate)) { + .depgraph_require_json_conformance(validate_split_spec_json(path)) + } + + parsed <- .depgraph_parse_json_file(path) obj_type <- parsed$splitGraph_object %||% NA_character_ if (!identical(as.character(obj_type), "split_spec")) { - stop( - "JSON at `", path, "` is not a serialized split_spec (found `", - obj_type, "`). Use `read_dependency_graph()` for dependency_graph files.", - call. = FALSE + .depgraph_stop( + c("JSON at `", path, "` is not a serialized split_spec (found `", + obj_type, "`). Use `read_dependency_graph()` for dependency_graph files."), + class = "splitgraph_schema_error", code = "unexpected_object_type" ) } @@ -513,22 +593,7 @@ read_split_spec <- function(path) { sample_rows <- parsed$sample_data %||% list() sample_data <- if (length(sample_rows) == 0L) { - data.frame( - sample_id = character(), - sample_node_id = character(), - group_id = character(), - primary_group = character(), - batch_group = character(), - study_group = character(), - site_group = character(), - region_group = character(), - platform_group = character(), - assay_group = character(), - timepoint_id = character(), - time_index = numeric(), - order_rank = integer(), - stringsAsFactors = FALSE - ) + .split_spec_sample_data_template(0L) } else { .depgraph_chr <- function(rows, key) { vapply(rows, function(r) { @@ -560,6 +625,7 @@ read_split_spec <- function(path) { region_group = .depgraph_chr(sample_rows, "region_group"), platform_group = .depgraph_chr(sample_rows, "platform_group"), assay_group = .depgraph_chr(sample_rows, "assay_group"), + stratum = .depgraph_chr(sample_rows, "stratum"), timepoint_id = .depgraph_chr(sample_rows, "timepoint_id"), time_index = .depgraph_num(sample_rows, "time_index"), order_rank = .depgraph_int(sample_rows, "order_rank"), @@ -578,19 +644,43 @@ read_split_spec <- function(path) { time_var_raw <- parsed$time_var time_var <- if (is.null(time_var_raw) || (length(time_var_raw) == 1L && is.na(time_var_raw))) NULL else as.character(time_var_raw) + stratum_var_raw <- parsed$stratum_var + stratum_var <- if (is.null(stratum_var_raw) || (length(stratum_var_raw) == 1L && is.na(stratum_var_raw))) NULL else as.character(stratum_var_raw) constraint_mode <- if (is.null(parsed$constraint_mode) || is.na(parsed$constraint_mode)) NULL else as.character(parsed$constraint_mode) constraint_strategy <- if (is.null(parsed$constraint_strategy) || is.na(parsed$constraint_strategy)) NULL else as.character(parsed$constraint_strategy) - recommended_resampling <- if (is.null(parsed$recommended_resampling) || is.na(parsed$recommended_resampling)) NULL else as.character(parsed$recommended_resampling) + recommended_resampling <- if (is.null(parsed$recommended_resampling) || + is.na(parsed$recommended_resampling)) { + NULL + } else { + as.character(parsed$recommended_resampling) + } - split_spec( + spec <- split_spec( sample_data = sample_data, group_var = parsed$group_var %||% "group_id", block_vars = block_vars, time_var = time_var, + stratum_var = stratum_var, ordering_required = isTRUE(parsed$ordering_required), constraint_mode = constraint_mode, constraint_strategy = constraint_strategy, recommended_resampling = recommended_resampling, metadata = .depgraph_metadata_split_spec_from_json(parsed$metadata) ) + + if (isTRUE(validate)) { + preflight <- validate_split_spec(spec) + if (!isTRUE(preflight$valid)) { + .depgraph_stop( + c( + "split_spec read from `", path, "` fails preflight validation:\n", + paste0(" - ", preflight$issues$message[preflight$issues$severity == "error"], collapse = "\n") + ), + class = "splitgraph_validation_error", + code = "split_spec_validation_failed" + ) + } + } + + spec } diff --git a/R/split-spec.R b/R/split-spec.R index c34f949..1d49514 100644 --- a/R/split-spec.R +++ b/R/split-spec.R @@ -1,6 +1,8 @@ # Helpers for translating splitGraph constraints into stable, tool-agnostic -# sample-level split specifications. Downstream packages (bioLeak, fastml, -# rsample, ...) consume `split_spec` objects through their own adapters. +# sample-level split specifications. Downstream consumers read `split_spec` +# objects through their own adapters: bioLeak (`as_leaksplits()`, the reference +# consumer), the shipped Python reader (`inst/python/splitspec`), and ad hoc +# adapters such as the rsample example in the adapter-cookbook vignette. .split_spec_sample_data_template <- function(n = 0L) { data.frame( @@ -14,6 +16,7 @@ region_group = rep(NA_character_, n), platform_group = rep(NA_character_, n), assay_group = rep(NA_character_, n), + stratum = rep(NA_character_, n), timepoint_id = rep(NA_character_, n), time_index = rep(NA_real_, n), order_rank = rep(NA_integer_, n), @@ -21,6 +24,51 @@ ) } +# Stratum annotation per sample: the key of the single Outcome node attached to +# the sample (`sample_has_outcome`), falling back to the single Outcome attached +# to the sample's single subject (`subject_has_outcome`). NA when no outcome is +# attached or when the attachment is not unique. +.split_spec_stratum_from_graph <- function(graph, sample_ids) { + edge_data <- graph$edges$data + node_data <- graph$nodes$data + key_of <- function(node_ids) node_data$node_key[match(node_ids, node_data$node_id)] + + stratum <- stats::setNames(rep(NA_character_, length(sample_ids)), sample_ids) + if (length(sample_ids) == 0L) return(character()) + + direct <- edge_data[edge_data$edge_type == "sample_has_outcome" & edge_data$from %in% sample_ids, c("from", "to"), drop = FALSE] + ambiguous <- character() + if (nrow(direct) > 0L) { + outcomes_by_sample <- lapply(split(direct$to, direct$from), unique) + unique_outcome <- lengths(outcomes_by_sample) == 1L + stratum[names(outcomes_by_sample)[unique_outcome]] <- key_of(unlist(outcomes_by_sample[unique_outcome], use.names = FALSE)) + # A sample with several outcomes has no unique stratum; it must stay NA + # rather than borrow its subject's label. + ambiguous <- names(outcomes_by_sample)[!unique_outcome] + } + + still_missing <- setdiff(names(stratum)[is.na(stratum)], ambiguous) + if (length(still_missing) > 0L) { + belongs <- edge_data[edge_data$edge_type == "sample_belongs_to_subject" & edge_data$from %in% still_missing, c("from", "to"), drop = FALSE] + subject_outcomes <- edge_data[edge_data$edge_type == "subject_has_outcome", c("from", "to"), drop = FALSE] + if (nrow(belongs) > 0L && nrow(subject_outcomes) > 0L) { + outcomes_by_subject <- lapply(split(subject_outcomes$to, subject_outcomes$from), unique) + unique_subject_outcome <- lengths(outcomes_by_subject) == 1L + subject_key <- stats::setNames( + key_of(unlist(outcomes_by_subject[unique_subject_outcome], use.names = FALSE)), + names(outcomes_by_subject)[unique_subject_outcome] + ) + subjects_by_sample <- lapply(split(belongs$to, belongs$from), unique) + unique_subject <- lengths(subjects_by_sample) == 1L + sample_ids_with_subject <- names(subjects_by_sample)[unique_subject] + subject_of <- unlist(subjects_by_sample[unique_subject], use.names = FALSE) + stratum[sample_ids_with_subject] <- unname(subject_key[subject_of]) + } + } + + unname(stratum) +} + .split_spec_new_issue <- function(severity, code, message, n_affected = 0L, details = list()) { data.frame( issue_id = NA_character_, @@ -77,39 +125,97 @@ matched$linked_key } -.split_spec_enrich_from_graph <- function(sample_data, graph) { - .depgraph_assert(inherits(graph, "dependency_graph"), "`graph` must be a `dependency_graph`.") - sample_ids <- sample_data$sample_node_id - - batch_assignments <- .depgraph_direct_assignment(graph, "batch", samples = sample_ids) - study_assignments <- .depgraph_direct_assignment(graph, "study", samples = sample_ids) - site_assignments <- .depgraph_direct_assignment(graph, "site", samples = sample_ids) - time_constraint <- .derive_time_constraints(graph, samples = sample_ids)$sample_map - time_constraint <- time_constraint[match(sample_ids, time_constraint$sample_node_id), , drop = FALSE] - - missing_batch <- is.na(sample_data$batch_group) | !nzchar(sample_data$batch_group) - sample_data$batch_group[missing_batch] <- .split_spec_match_assignment_key(batch_assignments, sample_ids)[missing_batch] +# Look up the direct assignment keys for one enrichment source. Enrichment is +# best-effort annotation, not the primary grouping, so an ambiguous assignment +# (e.g. a sample linked to two batches on a graph built with `validate = +# FALSE`) must not abort `as_split_spec()`. Such sources are left as NA and the +# reason is reported back so it can be recorded in the spec metadata. +.split_spec_enrichment_keys <- function(graph, mode, sample_ids) { + tryCatch( + list( + keys = .split_spec_match_assignment_key( + .depgraph_direct_assignment(graph, mode, samples = sample_ids), + sample_ids + ), + warning = character() + ), + error = function(e) { + list( + keys = rep(NA_character_, length(sample_ids)), + warning = paste0( + "Could not enrich `", mode, "_group` from the graph; the column was ", + "left as NA. Reason: ", conditionMessage(e) + ) + ) + } + ) +} - missing_study <- is.na(sample_data$study_group) | !nzchar(sample_data$study_group) - sample_data$study_group[missing_study] <- .split_spec_match_assignment_key(study_assignments, sample_ids)[missing_study] +.split_spec_enrichment_time <- function(graph, sample_ids) { + tryCatch( + { + time_map <- .derive_time_constraints(graph, samples = sample_ids)$sample_map + list( + table = time_map[match(sample_ids, time_map$sample_node_id), , drop = FALSE], + warning = character() + ) + }, + error = function(e) { + list( + table = data.frame( + timepoint_id = rep(NA_character_, length(sample_ids)), + time_index = rep(NA_real_, length(sample_ids)), + order_rank = rep(NA_integer_, length(sample_ids)), + stringsAsFactors = FALSE + ), + warning = paste0( + "Could not enrich time ordering (`timepoint_id`, `time_index`, ", + "`order_rank`) from the graph; the columns were left as NA. Reason: ", + conditionMessage(e) + ) + ) + } + ) +} - missing_site <- is.na(sample_data$site_group) | !nzchar(sample_data$site_group) - sample_data$site_group[missing_site] <- .split_spec_match_assignment_key(site_assignments, sample_ids)[missing_site] +.split_spec_fill_missing <- function(current, replacement) { + missing <- is.na(current) | !nzchar(as.character(current)) + current[missing] <- replacement[missing] + current +} - region_assignments <- .depgraph_direct_assignment(graph, "region", samples = sample_ids) - missing_region <- is.na(sample_data$region_group) | !nzchar(sample_data$region_group) - sample_data$region_group[missing_region] <- .split_spec_match_assignment_key(region_assignments, sample_ids)[missing_region] +# Returns `sample_data` with the blocking / ordering annotation columns filled +# from the graph wherever the constraint left them NA. Any source that could +# not be resolved is reported through the "enrichment_warnings" attribute. +.split_spec_enrich_from_graph <- function(sample_data, graph) { + .depgraph_assert(inherits(graph, "dependency_graph"), "`graph` must be a `dependency_graph`.") + sample_ids <- sample_data$sample_node_id + enrichment_warnings <- character() + + group_sources <- c( + batch_group = "batch", + study_group = "study", + site_group = "site", + region_group = "region", + platform_group = "platform", + assay_group = "assay" + ) + for (column in names(group_sources)) { + lookup <- .split_spec_enrichment_keys(graph, group_sources[[column]], sample_ids) + sample_data[[column]] <- .split_spec_fill_missing(sample_data[[column]], lookup$keys) + enrichment_warnings <- c(enrichment_warnings, lookup$warning) + } - platform_assignments <- .depgraph_direct_assignment(graph, "platform", samples = sample_ids) - missing_platform <- is.na(sample_data$platform_group) | !nzchar(sample_data$platform_group) - sample_data$platform_group[missing_platform] <- .split_spec_match_assignment_key(platform_assignments, sample_ids)[missing_platform] + time_lookup <- .split_spec_enrichment_time(graph, sample_ids) + time_constraint <- time_lookup$table + enrichment_warnings <- c(enrichment_warnings, time_lookup$warning) - assay_assignments <- .depgraph_direct_assignment(graph, "assay", samples = sample_ids) - missing_assay <- is.na(sample_data$assay_group) | !nzchar(sample_data$assay_group) - sample_data$assay_group[missing_assay] <- .split_spec_match_assignment_key(assay_assignments, sample_ids)[missing_assay] + sample_data$stratum <- .split_spec_fill_missing( + sample_data$stratum, + .split_spec_stratum_from_graph(graph, sample_ids) + ) - missing_timepoint <- is.na(sample_data$timepoint_id) | !nzchar(sample_data$timepoint_id) - sample_data$timepoint_id[missing_timepoint] <- time_constraint$timepoint_id[missing_timepoint] + sample_data$timepoint_id <- .split_spec_fill_missing(sample_data$timepoint_id, time_constraint$timepoint_id) missing_time_index <- is.na(sample_data$time_index) sample_data$time_index[missing_time_index] <- time_constraint$time_index[missing_time_index] @@ -117,6 +223,7 @@ missing_order <- is.na(sample_data$order_rank) sample_data$order_rank[missing_order] <- time_constraint$order_rank[missing_order] + attr(sample_data, "enrichment_warnings") <- enrichment_warnings sample_data } @@ -146,16 +253,37 @@ #' #' The translation layer always produces canonical sample-level columns #' including \code{sample_id}, \code{sample_node_id}, \code{group_id}, and -#' \code{primary_group}. When available, it also carries \code{batch_group}, -#' \code{study_group}, \code{timepoint_id}, \code{time_index}, and -#' \code{order_rank}. Missing but relevant fields are retained as \code{NA} -#' columns rather than omitted. +#' \code{primary_group}. When available, it also carries the blocking columns +#' (\code{batch_group}, \code{study_group}, \code{site_group}, +#' \code{region_group}, \code{platform_group}, \code{assay_group}), the +#' \code{stratum} annotation, and the ordering columns (\code{timepoint_id}, +#' \code{time_index}, \code{order_rank}). Missing but relevant fields are +#' retained as \code{NA} columns rather than omitted. +#' +#' \code{stratum} is filled from the graph when one is supplied: the key of the +#' single \code{Outcome} node attached to a sample via +#' \code{sample_has_outcome}, or, failing that, the single outcome attached to +#' the sample's subject via \code{subject_has_outcome}. It is an +#' \emph{annotation} of the outcome level each sample carries, exposed through +#' \code{stratum_var} so a downstream consumer (for example scikit-learn's +#' \code{StratifiedGroupKFold}) can stratify; splitGraph itself never balances +#' folds. When no sample has a unique outcome, \code{stratum_var} is +#' \code{NULL}. #' #' When only a subset of samples has ordering metadata, the translated split #' spec still exposes that partial ordering through \code{time_var}, but #' \code{ordering_required} remains \code{FALSE}. Ordering is only marked as #' required when the constraint implies complete ordering coverage. #' +#' When \code{graph} is supplied, the blocking and ordering annotation columns +#' are filled from the graph wherever the constraint left them \code{NA}. This +#' enrichment is best-effort: a source that cannot be resolved unambiguously +#' (for example a sample linked to two batches on a graph built with +#' \code{validate = FALSE}) is left as \code{NA} and the reason is recorded in +#' \code{metadata$enrichment_warnings} (and appended to +#' \code{metadata$warnings}) instead of aborting the translation. The primary +#' \code{group_id} always comes from the constraint and is never affected. +#' #' The split-spec validator checks: #' \itemize{ #' \item missing required columns @@ -179,6 +307,36 @@ #' \code{split_constraint} metadata rather than duplicating downstream #' evaluation logic. #' +#' @section What downstream consumers read: +#' The \code{split_spec} contract is wider than any single consumer uses today. +#' Verified against the released versions on 2026-09-14: +#' +#' \tabular{lll}{ +#' \strong{Consumer} \tab \strong{Reads} \tab \strong{Modes} \cr +#' bioLeak 0.3.8 \code{as_leaksplits()} \tab +#' \code{sample_data} columns \code{sample_id}, the \code{group_var} column, +#' \code{batch_group}, \code{study_group}, \code{timepoint_id}, +#' \code{order_rank}; fields \code{group_var}, \code{constraint_mode}, +#' \code{time_var} \tab +#' subject, batch, study, time. Every other \code{constraint_mode} +#' currently \emph{errors} inside bioLeak: site, region, platform, assay, +#' relatedness and spatial are absent from its mode map ("subscript out of +#' bounds"), and composite maps to \code{make_split_plan(mode = +#' "combined")} without the \code{constraints} / \code{primary_axis} that +#' mode requires. Until that is fixed, join \code{group_id} onto your +#' observation frame and call \code{bioLeak::make_split_plan(group = +#' "group_id")} directly; the grouping is preserved. \cr +#' Python \code{splitspec} reader (shipped) \tab +#' every field and column, including \code{stratum_var} / \code{stratum} +#' and the block columns \tab all \cr +#' rsample (adapter-cookbook vignette) \tab +#' \code{group_id} for \code{group_vfold_cv()}, \code{order_rank} for +#' \code{rolling_origin()}; block columns read for fold auditing \tab all \cr +#' } +#' Every row is pinned by a contract test (run when bioLeak is installed), +#' including the workaround, so the seam cannot drift silently; the test fails +#' deliberately when a bioLeak release starts accepting the other modes. +#' #' @param constraint A \code{split_constraint}. #' @param graph A \code{dependency_graph}. #' @param split_spec An optional \code{split_spec}. @@ -242,8 +400,11 @@ as_split_spec <- function(constraint, graph = NULL) { } enrichment_used <- FALSE + enrichment_warnings <- character() if (!is.null(graph)) { sample_data <- .split_spec_enrich_from_graph(sample_data, graph) + enrichment_warnings <- attr(sample_data, "enrichment_warnings", exact = TRUE) %||% character() + attr(sample_data, "enrichment_warnings") <- NULL enrichment_used <- TRUE } @@ -268,6 +429,7 @@ as_split_spec <- function(constraint, graph = NULL) { } time_var <- if (!all(is.na(sample_data$order_rank))) "order_rank" else NULL + stratum_var <- if (!all(is.na(sample_data$stratum))) "stratum" else NULL ordering_required <- isTRUE(constraint$recommended_downstream_args$ordering_required) split_spec( @@ -275,6 +437,7 @@ as_split_spec <- function(constraint, graph = NULL) { group_var = "group_id", block_vars = block_vars, time_var = time_var, + stratum_var = stratum_var, ordering_required = ordering_required, constraint_mode = mode, constraint_strategy = strategy, @@ -285,12 +448,18 @@ as_split_spec <- function(constraint, graph = NULL) { source_mode = mode, source_strategy = strategy, relations_used = constraint$metadata$relations_used %||% character(), + via = as.character(constraint$metadata$via %||% character()), + priority = as.character(constraint$metadata$priority %||% character()), + threshold = constraint$metadata$threshold %||% NA_real_, + threshold_metric = constraint$metadata$threshold_metric %||% NA_character_, splitgraph_version = .depgraph_package_version(), + igraph_version = tryCatch(as.character(utils::packageVersion("igraph")), error = function(e) NA_character_), derived_at = format(Sys.time(), "%Y-%m-%dT%H:%M:%OS6%z"), n_samples = nrow(sample_data), n_groups = length(unique(sample_data$group_id)), - warnings = constraint$metadata$warnings %||% character(), - enriched_from_graph = enrichment_used + warnings = c(constraint$metadata$warnings %||% character(), enrichment_warnings), + enriched_from_graph = enrichment_used, + enrichment_warnings = enrichment_warnings ) ) } @@ -399,6 +568,35 @@ validate_split_spec <- function(x) { } } + if (!is.null(x$stratum_var)) { + if (!x$stratum_var %in% names(data)) { + issues[[length(issues) + 1L]] <- .split_spec_new_issue( + severity = "error", + code = "invalid_stratum_var", + message = paste0("Declared `stratum_var` is not present in `sample_data`: ", x$stratum_var) + ) + } else { + stratum_missing <- is.na(data[[x$stratum_var]]) | !nzchar(as.character(data[[x$stratum_var]])) + if (all(stratum_missing)) { + issues[[length(issues) + 1L]] <- .split_spec_new_issue( + severity = "warning", + code = "empty_stratum_var", + message = paste0("Stratum variable `", x$stratum_var, "` is present but empty for all samples.") + ) + } else if (any(stratum_missing)) { + issues[[length(issues) + 1L]] <- .split_spec_new_issue( + severity = "advisory", + code = "partial_stratum", + message = paste0( + "Stratum variable `", x$stratum_var, "` is missing for ", + sum(stratum_missing), " of ", nrow(data), " samples." + ), + n_affected = sum(stratum_missing) + ) + } + } + } + split_spec_validation( issues = .split_spec_bind_issues(issues), metadata = list( @@ -437,6 +635,9 @@ validate_split_spec <- function(x) { subject_cross_study_overlap = mode %in% c("subject", "study") || composite_covers("subject") || composite_covers("study"), + subject_cross_site_overlap = mode %in% c("subject", "site") || + composite_covers("subject") || + composite_covers("site"), heavy_batch_reuse = identical(mode, "batch") || composite_covers("batch"), missing_time_ordering = identical(mode, "time") || composite_covers("time"), per_dataset_featureset = FALSE, @@ -669,6 +870,7 @@ summarize_leakage_risks <- function(graph, constraint = NULL, split_spec = NULL, message = character(), source = character(), n_affected = integer(), + severed = logical(), stringsAsFactors = FALSE ) } else { diff --git a/R/splitGraph-package.R b/R/splitGraph-package.R index 5b785ec..b410a54 100644 --- a/R/splitGraph-package.R +++ b/R/splitGraph-package.R @@ -55,9 +55,14 @@ # contract with shipped JSON Schemas (`inst/schema/`), a `$schema` reference in # output, split_spec provenance (`splitgraph_version`, `derived_at`), and the # node/edge/column additions from the 0.3.0 development cycle (Site, Region, -# Platform, the pairwise relations, and their split_spec annotations). All of -# those are additive within MAJOR 0, so "0.1.0" files still load silently. -.depgraph_schema_version <- "0.2.0" +# Platform, the pairwise relations, and their split_spec annotations). "0.3.0" +# (package 0.4.0) adds the `stratum` column and `stratum_var` to split_spec, +# `edge_sources` (thresholds and column provenance) to graph metadata, richer +# split_spec provenance (`via`, `priority`, `threshold`, `igraph_version`, +# `enrichment_warnings`), and moves the shipped schemas under a versioned +# directory (`inst/schema//`). All of those are additive within +# MAJOR 0, so "0.1.0" and "0.2.0" files still load silently. +.depgraph_schema_version <- "0.3.0" .depgraph_node_types <- c( "Sample", "Subject", "Batch", "Study", @@ -312,12 +317,102 @@ rep(list(list()), n) } -.depgraph_assert <- function(condition, message) { +#' Classed Conditions Signalled by splitGraph +#' +#' Every error raised by \pkg{splitGraph} is a classed condition that inherits +#' from \code{"splitgraph_error"} (and \code{"error"}), so callers can handle +#' the package's failures selectively with \code{tryCatch()} without matching +#' on message text. Each condition also carries a machine-readable \code{code} +#' field drawn from the same vocabulary as the \code{code} column of a +#' \code{depgraph_validation_report} where one applies (for example +#' \code{"missing_source_node"} or \code{"sample_multiple_batch_assignments"}), +#' and \code{NA} otherwise. +#' +#' @section Condition classes: +#' \describe{ +#' \item{\code{splitgraph_error}}{Base class of every splitGraph error, +#' including argument checks that do not fall in a category below.} +#' \item{\code{splitgraph_schema_error}}{The input violates the typed schema: +#' an unsupported node or edge type, an edge whose endpoints have the wrong +#' node types, a graph with no \code{Sample} node, or a JSON document that +#' is not the expected splitGraph object.} +#' \item{\code{splitgraph_reference_error}}{An identifier does not resolve or +#' is not unique: edge endpoints missing from the node table, duplicated +#' node or edge ids, unknown node or sample ids passed to a query, or a +#' missing edge endpoint value.} +#' \item{\code{splitgraph_ambiguity_error}}{The structure admits more than +#' one answer where exactly one is required: conflicting definitions for +#' the same node or edge, or a sample linked to several targets of a +#' single-valued relation when deriving a direct constraint.} +#' \item{\code{splitgraph_validation_error}}{\code{validate_graph(error_on_fail +#' = TRUE)} or \code{build_dependency_graph(validate = TRUE)} found +#' error-severity issues, or timepoint ordering metadata are inconsistent.} +#' \item{\code{splitgraph_io_error}}{A file could not be written or parsed.} +#' } +#' Warnings raised by the package carry the class \code{"splitgraph_warning"}. +#' +#' @examples +#' meta <- data.frame(sample_id = c("S1", "S2"), subject_id = c("P1", "P2")) +#' g <- graph_from_metadata(meta) +#' res <- tryCatch( +#' query_neighbors(g, "sample:does-not-exist"), +#' splitgraph_reference_error = function(e) e$code +#' ) +#' res +#' @name splitgraph_conditions +NULL + +.depgraph_condition_classes <- function(class) { + unique(c(class, "splitgraph_error")) +} + +# Signal a classed splitGraph error. `class` may name one of the documented +# subclasses (see ?splitgraph_conditions); `code` is the machine-readable code +# shared with the validation-report vocabulary where one applies. +.depgraph_stop <- function(message, class = "splitgraph_error", code = NA_character_) { + cond <- structure( + class = c(.depgraph_condition_classes(class), "error", "condition"), + list(message = paste0(message, collapse = ""), call = NULL, code = as.character(code)[1L]) + ) + stop(cond) +} + +.depgraph_warn <- function(message, class = "splitgraph_warning", code = NA_character_) { + cond <- structure( + class = c(unique(c(class, "splitgraph_warning")), "warning", "condition"), + list(message = paste0(message, collapse = ""), call = NULL, code = as.character(code)[1L]) + ) + warning(cond) +} + +.depgraph_assert <- function(condition, message, class = "splitgraph_error", code = NA_character_) { if (!isTRUE(condition)) { - stop(message, call. = FALSE) + .depgraph_stop(message, class = class, code = code) } } +# `match.arg()` with a classed error, so an invalid `mode =` / `format =` is a +# `splitgraph_error` like every other failure the package raises. `arg` may be +# the full default vector (as with match.arg()), in which case the first +# choice is returned. +.depgraph_match_arg <- function(arg, choices, name) { + if (identical(arg, choices)) { + return(choices[[1L]]) + } + .depgraph_assert( + is.character(arg) && length(arg) == 1L && !is.na(arg), + paste0("`", name, "` must be a single string; one of: ", paste(choices, collapse = ", "), "."), + code = "invalid_argument" + ) + hit <- pmatch(arg, choices, nomatch = 0L, duplicates.ok = FALSE) + .depgraph_assert( + hit > 0L, + paste0("`", name, "` must be one of: ", paste(choices, collapse = ", "), " (got \"", arg, "\")."), + code = "invalid_argument" + ) + choices[[hit]] +} + # Installed splitGraph package version as a string, for stamping provenance. # Returns NA_character_ if the version cannot be resolved (e.g. exotic loads). .depgraph_package_version <- function() { @@ -327,7 +422,10 @@ .depgraph_match_node_type <- function(type) { .depgraph_assert(length(type) == 1L && !is.na(type), "`type` must be length 1.") match_idx <- match(tolower(type), tolower(.depgraph_node_types)) - .depgraph_assert(!is.na(match_idx), paste0("Unsupported node type: ", type)) + .depgraph_assert( + !is.na(match_idx), paste0("Unsupported node type: ", type), + class = "splitgraph_schema_error", code = "unsupported_node_type" + ) .depgraph_node_types[[match_idx]] } @@ -389,18 +487,25 @@ paste0("Missing attribute columns: ", paste(missing_cols, collapse = ", ")) ) - attrs <- lapply(seq_len(nrow(data)), function(i) { - as.list(data[i, attr_cols, drop = FALSE]) - }) + # One named list per row, built column-wise: identical to + # `as.list(data[i, attr_cols, drop = FALSE])` for each row, without the + # per-row data.frame subsetting that dominated large builds. + columns <- lapply(data[attr_cols], as.list) + attrs <- do.call(Map, c(list(f = function(...) list(...)), columns)) + names(attrs) <- NULL I(attrs) } .depgraph_validate_node_attrs <- function(node_type, attrs) { schema <- .depgraph_node_type_schema(node_type) attr_names <- names(attrs) + if (is.null(attr_names)) attr_names <- character() + allowed <- c(schema$required_attrs, schema$optional_attrs) - missing_required <- setdiff(schema$required_attrs, attr_names) - unknown_attrs <- setdiff(attr_names, c(schema$required_attrs, schema$optional_attrs)) + # `%in%` instead of setdiff(): same result for these character vectors, + # without setdiff()'s per-call coercion overhead (this runs once per node). + missing_required <- schema$required_attrs[!schema$required_attrs %in% attr_names] + unknown_attrs <- unique(attr_names[!attr_names %in% allowed]) list( missing_required = missing_required, @@ -453,15 +558,14 @@ )) } - graph_edges <- graph_edges[, required_edge_cols, drop = FALSE] - table_edges <- edge_data[, required_edge_cols, drop = FALSE] - - graph_edges <- graph_edges[do.call(order, unname(graph_edges)), , drop = FALSE] - table_edges <- table_edges[do.call(order, unname(table_edges)), , drop = FALSE] - row.names(graph_edges) <- NULL - row.names(table_edges) <- NULL - - if (!identical(graph_edges, table_edges)) { + # Compare the two edge tables as multisets of composite keys. A radix sort of + # one character vector is far cheaper than ordering four string columns with + # locale collation, and the result is the same: equal iff every + # (from, to, edge_id, edge_type) tuple occurs equally often on both sides. + graph_keys <- do.call(paste, c(unname(as.list(graph_edges[, required_edge_cols, drop = FALSE])), sep = "\r")) + table_keys <- do.call(paste, c(unname(as.list(edge_data[, required_edge_cols, drop = FALSE])), sep = "\r")) + if (length(graph_keys) != length(table_keys) || + !identical(sort(graph_keys, method = "radix"), sort(table_keys, method = "radix"))) { return(list( valid = FALSE, message = "The embedded `igraph` does not match the supplied node and edge tables." @@ -495,7 +599,7 @@ data$node_type <- as.character(data$node_type) data$node_key <- as.character(data$node_key) data$label <- as.character(data$label) - data$attrs <- I(lapply(data$attrs, .depgraph_normalize_attr_entry, context = "`attrs`")) + data$attrs <- .depgraph_normalize_attr_column(data$attrs) .depgraph_assert( all(!is.na(data$node_id) & nzchar(data$node_id)), @@ -540,7 +644,7 @@ data$from <- as.character(data$from) data$to <- as.character(data$to) data$edge_type <- as.character(data$edge_type) - data$attrs <- I(lapply(data$attrs, .depgraph_normalize_attr_entry, context = "`attrs`")) + data$attrs <- .depgraph_normalize_attr_column(data$attrs) .depgraph_assert( all(!is.na(data$edge_id) & nzchar(data$edge_id)), @@ -572,6 +676,28 @@ ) } +# Normalise a list-column of attribute entries. Fast path: when every entry is +# already an empty list (the common case for nodes built from an id column +# alone) there is nothing to check or convert. +.depgraph_normalize_attr_column <- function(attrs, context = "`attrs`") { + if (length(attrs) == 0L || all(lengths(attrs) == 0L)) { + return(I(rep(list(list()), length(attrs)))) + } + I(lapply(attrs, .depgraph_normalize_attr_entry, context = context)) +} + +# Number of distinct `values` per level of `by`, as a data.frame(by, n) ordered +# by `by` (the same order `stats::aggregate()` produced, without its factor +# machinery on every call). +.depgraph_count_unique_by <- function(values, by) { + groups <- split(values, by) + data.frame( + by = names(groups), + n = unname(lengths(lapply(groups, unique))), + stringsAsFactors = FALSE + ) +} + .depgraph_bind_data <- function(objects, field) { if (inherits(objects, c("graph_node_set", "graph_edge_set"))) { objects <- list(objects) diff --git a/R/validate.R b/R/validate.R index 2e14120..2b2aee2 100644 --- a/R/validate.R +++ b/R/validate.R @@ -31,7 +31,38 @@ ) } +# Bulk variant of `.new_validation_issue()`: one issue per element of +# `messages`, with per-issue node/edge id vectors supplied as lists. Building the +# table once instead of rbind-ing one-row frames is what keeps validation linear +# on cohorts with thousands of per-subject advisories. +.new_validation_issues <- function(level, severity, code, messages, node_ids = NULL, edge_ids = NULL, details = NULL) { + n <- length(messages) + if (n == 0L) { + return(NULL) + } + .depgraph_assert(level %in% .depgraph_validation_levels, paste0("Unsupported validation level: ", level)) + .depgraph_assert(severity %in% .depgraph_validation_severities, paste0("Unsupported validation severity: ", severity)) + + node_ids <- if (is.null(node_ids)) rep(list(character()), n) else lapply(node_ids, as.character) + edge_ids <- if (is.null(edge_ids)) rep(list(character()), n) else lapply(edge_ids, as.character) + details <- if (is.null(details)) rep(list(list()), n) else details + details <- lapply(details, .depgraph_normalize_attr_entry, context = "`details`") + + data.frame( + issue_id = NA_character_, + level = level, + severity = severity, + code = code, + message = as.character(messages), + node_ids = I(unname(node_ids)), + edge_ids = I(unname(edge_ids)), + details = I(unname(details)), + stringsAsFactors = FALSE + ) +} + .depgraph_bind_issues <- function(issues) { + issues <- Filter(Negate(is.null), issues) if (length(issues) == 0L) { return(.depgraph_empty_issue_data()) } @@ -61,20 +92,6 @@ ) } -.depgraph_old_checks_to_levels <- function(checks) { - checks <- unique(as.character(checks)) - levels <- character() - - if (any(checks %in% c("ids", "references", "cardinality"))) { - levels <- c(levels, "structural") - } - if (any(checks %in% c("schema", "time", "cardinality"))) { - levels <- c(levels, "semantic") - } - - unique(levels) -} - .validate_structural <- function(graph) { node_data <- graph$nodes$data edge_data <- graph$edges$data @@ -177,36 +194,45 @@ ) } - type_map <- stats::setNames(node_data$node_type, node_data$node_id) if (nrow(edge_data) > 0L) { - for (i in seq_len(nrow(edge_data))) { - edge_type <- edge_data$edge_type[[i]] - schema_row <- .depgraph_edge_type_schema(edge_type) - if (nrow(schema_row) == 0L) { - issues[[length(issues) + 1L]] <- .new_validation_issue( - level = "structural", - severity = "error", - code = "unsupported_edge_type", - message = paste0("Unknown edge type encountered: ", edge_type), - edge_ids = edge_data$edge_id[[i]] - ) - next - } + # Vectorised signature check: one join of the edge table against the schema. + type_map <- stats::setNames(node_data$node_type, node_data$node_id) + schema_idx <- match(edge_data$edge_type, .depgraph_edge_schema$edge_type) + unknown <- is.na(schema_idx) - observed_from <- unname(type_map[[edge_data$from[[i]]]]) - observed_to <- unname(type_map[[edge_data$to[[i]]]]) - if (!identical(observed_from, schema_row$from_type[[1L]]) || !identical(observed_to, schema_row$to_type[[1L]])) { - issues[[length(issues) + 1L]] <- .new_validation_issue( + if (any(unknown)) { + issues[[length(issues) + 1L]] <- .new_validation_issues( + level = "structural", + severity = "error", + code = "unsupported_edge_type", + messages = paste0("Unknown edge type encountered: ", edge_data$edge_type[unknown]), + edge_ids = as.list(edge_data$edge_id[unknown]) + ) + } + + known <- which(!unknown) + if (length(known) > 0L) { + expected_from <- .depgraph_edge_schema$from_type[schema_idx[known]] + expected_to <- .depgraph_edge_schema$to_type[schema_idx[known]] + observed_from <- unname(type_map[edge_data$from[known]]) + observed_to <- unname(type_map[edge_data$to[known]]) + # An endpoint missing from the node table (reported separately above) + # compares as NA; treat it as a mismatch, as the per-edge loop did. + bad <- is.na(observed_from) | is.na(observed_to) | + observed_from != expected_from | observed_to != expected_to + bad_idx <- known[bad] + if (length(bad_idx) > 0L) { + issues[[length(issues) + 1L]] <- .new_validation_issues( level = "structural", severity = "error", code = "invalid_edge_signature", - message = paste0( - "Edge `", edge_data$edge_id[[i]], "` violates schema for `", edge_type, - "` (expected ", schema_row$from_type[[1L]], " -> ", schema_row$to_type[[1L]], - ", found ", observed_from, " -> ", observed_to, ")." + messages = paste0( + "Edge `", edge_data$edge_id[bad_idx], "` violates schema for `", edge_data$edge_type[bad_idx], + "` (expected ", expected_from[bad], " -> ", expected_to[bad], + ", found ", observed_from[bad], " -> ", observed_to[bad], ")." ), - node_ids = c(edge_data$from[[i]], edge_data$to[[i]]), - edge_ids = edge_data$edge_id[[i]] + node_ids = Map(c, edge_data$from[bad_idx], edge_data$to[bad_idx]), + edge_ids = as.list(edge_data$edge_id[bad_idx]) ) } } @@ -218,12 +244,8 @@ next } edge_subset <- edge_data[subset_idx, c("edge_id", "from", "to"), drop = FALSE] - counts <- stats::aggregate( - edge_subset$to, - by = list(from = edge_subset$from), - FUN = function(x) length(unique(x)) - ) - bad <- counts[counts$x > 1L, , drop = FALSE] + counts <- .depgraph_count_unique_by(edge_subset$to, edge_subset$from) + bad <- data.frame(from = counts$by[counts$n > 1L], stringsAsFactors = FALSE) if (nrow(bad) > 0L) { offending_edges <- edge_subset$edge_id[edge_subset$from %in% bad$from] issues[[length(issues) + 1L]] <- .new_validation_issue( @@ -249,35 +271,52 @@ edge_data <- graph$edges$data issues <- list() - for (i in seq_len(nrow(node_data))) { - attr_check <- .depgraph_validate_node_attrs( - node_type = node_data$node_type[[i]], - attrs = node_data$attrs[[i]] + if (nrow(node_data) > 0L) { + # Only nodes that carry attributes can have unknown ones, and no node type + # currently declares required attributes; still evaluate the required check + # for every node type present (once per type, not once per node) so a + # future schema with required attrs keeps working. + has_attrs <- lengths(node_data$attrs) > 0L + required_by_type <- vapply( + unique(node_data$node_type), + function(type) length(.depgraph_node_type_schema(type)$required_attrs) > 0L, + logical(1) ) + needs_check <- has_attrs | required_by_type[node_data$node_type] - if (length(attr_check$missing_required) > 0L) { - issues[[length(issues) + 1L]] <- .new_validation_issue( + checks <- vector("list", nrow(node_data)) + checks[needs_check] <- Map( + function(type, attrs) .depgraph_validate_node_attrs(type, attrs), + node_data$node_type[needs_check], node_data$attrs[needs_check] + ) + missing_required <- lapply(checks, function(x) if (is.null(x)) character() else x$missing_required) + unknown_attrs <- lapply(checks, function(x) if (is.null(x)) character() else x$unknown_attrs) + + miss_idx <- which(lengths(missing_required) > 0L) + if (length(miss_idx) > 0L) { + issues[[length(issues) + 1L]] <- .new_validation_issues( level = "semantic", severity = "error", code = "missing_required_node_attr", - message = paste0( - "Node `", node_data$node_id[[i]], "` is missing required attributes: ", - paste(attr_check$missing_required, collapse = ", ") + messages = paste0( + "Node `", node_data$node_id[miss_idx], "` is missing required attributes: ", + vapply(missing_required[miss_idx], paste, character(1), collapse = ", ") ), - node_ids = node_data$node_id[[i]] + node_ids = as.list(node_data$node_id[miss_idx]) ) } - if (length(attr_check$unknown_attrs) > 0L) { - issues[[length(issues) + 1L]] <- .new_validation_issue( + unk_idx <- which(has_attrs & lengths(unknown_attrs) > 0L) + if (length(unk_idx) > 0L) { + issues[[length(issues) + 1L]] <- .new_validation_issues( level = "semantic", severity = "warning", code = "non_canonical_node_attr", - message = paste0( - "Node `", node_data$node_id[[i]], "` contains non-canonical attributes: ", - paste(attr_check$unknown_attrs, collapse = ", ") + messages = paste0( + "Node `", node_data$node_id[unk_idx], "` contains non-canonical attributes: ", + vapply(unknown_attrs[unk_idx], paste, character(1), collapse = ", ") ), - node_ids = node_data$node_id[[i]] + node_ids = as.list(node_data$node_id[unk_idx]) ) } } @@ -293,15 +332,9 @@ names(targets) <- sample_ids if (nrow(relation_edges) > 0L) { - observed_counts <- stats::aggregate( - relation_edges$to, - by = list(from = relation_edges$from), - FUN = function(x) length(unique(x)) - ) - counts[observed_counts$from] <- observed_counts$x - for (sample_id in unique(relation_edges$from)) { - targets[[sample_id]] <- unique(relation_edges$to[relation_edges$from == sample_id]) - } + targets_by_sample <- lapply(split(relation_edges$to, relation_edges$from), unique) + counts[names(targets_by_sample)] <- lengths(targets_by_sample) + targets[names(targets_by_sample)] <- targets_by_sample } if (!is.null(rule$missing_code) && !is.null(rule$missing_severity) && rule$min_targets > 0L) { @@ -461,23 +494,18 @@ subject_edges <- edge_data[edge_data$edge_type == "sample_belongs_to_subject", c("edge_id", "from", "to"), drop = FALSE] if (nrow(subject_edges) > 0L) { - sample_counts <- stats::aggregate( - subject_edges$from, - by = list(subject = subject_edges$to), - FUN = function(x) length(unique(x)) - ) - repeated <- sample_counts[sample_counts$x > 1L, , drop = FALSE] - for (i in seq_len(nrow(repeated))) { - subject_id <- repeated$subject[[i]] - sample_ids <- unique(subject_edges$from[subject_edges$to == subject_id]) - edge_ids <- subject_edges$edge_id[subject_edges$to == subject_id] - issues[[length(issues) + 1L]] <- .new_validation_issue( + sample_counts <- .depgraph_count_unique_by(subject_edges$from, subject_edges$to) + subject_ids <- sample_counts$by[sample_counts$n > 1L] + if (length(subject_ids) > 0L) { + samples_by_subject <- split(subject_edges$from, subject_edges$to) + edges_by_subject <- split(subject_edges$edge_id, subject_edges$to) + issues[[length(issues) + 1L]] <- .new_validation_issues( level = "leakage", severity = "advisory", code = "repeated_subject_samples", - message = paste0("Subject `", subject_id, "` is linked to multiple samples."), - node_ids = c(subject_id, sample_ids), - edge_ids = edge_ids + messages = paste0("Subject `", subject_ids, "` is linked to multiple samples."), + node_ids = Map(function(s, samples) c(s, unique(samples)), subject_ids, samples_by_subject[subject_ids]), + edge_ids = edges_by_subject[subject_ids] ) } } @@ -491,21 +519,47 @@ suffixes = c("_subject", "_study") ) if (nrow(subject_study) > 0L) { - study_counts <- stats::aggregate( - subject_study$to_study, - by = list(subject = subject_study$to_subject), - FUN = function(x) length(unique(x)) - ) - cross_study <- study_counts[study_counts$x > 1L, , drop = FALSE] - for (i in seq_len(nrow(cross_study))) { - subject_id <- cross_study$subject[[i]] - linked_samples <- unique(subject_study$from[subject_study$to_subject == subject_id]) - issues[[length(issues) + 1L]] <- .new_validation_issue( + study_counts <- .depgraph_count_unique_by(subject_study$to_study, subject_study$to_subject) + subject_ids <- study_counts$by[study_counts$n > 1L] + if (length(subject_ids) > 0L) { + samples_by_subject <- split(subject_study$from, subject_study$to_subject) + issues[[length(issues) + 1L]] <- .new_validation_issues( level = "leakage", severity = "warning", code = "subject_cross_study_overlap", - message = paste0("Subject `", subject_id, "` appears across multiple studies."), - node_ids = c(subject_id, linked_samples) + messages = paste0("Subject `", subject_ids, "` appears across multiple studies."), + node_ids = Map(function(s, samples) c(s, unique(samples)), subject_ids, samples_by_subject[subject_ids]) + ) + } + } + } + + # A subject whose samples were collected at several sites: mirrors the + # cross-study rule. Grouping by site alone would then place one individual + # in several site groups, and a site holdout would leak that individual. + site_edges <- edge_data[edge_data$edge_type == "sample_collected_at_site", c("edge_id", "from", "to"), drop = FALSE] + if (nrow(subject_edges) > 0L && nrow(site_edges) > 0L) { + subject_site <- merge( + subject_edges[, c("from", "to")], + site_edges[, c("from", "to")], + by = "from", + suffixes = c("_subject", "_site") + ) + if (nrow(subject_site) > 0L) { + site_counts <- .depgraph_count_unique_by(subject_site$to_site, subject_site$to_subject) + subject_ids <- site_counts$by[site_counts$n > 1L] + if (length(subject_ids) > 0L) { + samples_by_subject <- split(subject_site$from, subject_site$to_subject) + sites_by_subject <- split(subject_site$to_site, subject_site$to_subject) + issues[[length(issues) + 1L]] <- .new_validation_issues( + level = "leakage", + severity = "warning", + code = "subject_cross_site_overlap", + messages = paste0("Subject `", subject_ids, "` has samples collected at multiple sites."), + node_ids = Map( + function(s, samples, sites) c(s, unique(samples), unique(sites)), + subject_ids, samples_by_subject[subject_ids], sites_by_subject[subject_ids] + ) ) } } @@ -529,23 +583,18 @@ feature_edges <- edge_data[edge_data$edge_type == "sample_uses_featureset", c("edge_id", "from", "to"), drop = FALSE] if (nrow(feature_edges) > 0L) { - feature_counts <- stats::aggregate( - feature_edges$from, - by = list(featureset = feature_edges$to), - FUN = function(x) length(unique(x)) - ) - shared <- feature_counts[feature_counts$x > 1L, , drop = FALSE] - for (i in seq_len(nrow(shared))) { - featureset_id <- shared$featureset[[i]] - linked_samples <- unique(feature_edges$from[feature_edges$to == featureset_id]) - edge_ids <- feature_edges$edge_id[feature_edges$to == featureset_id] - issues[[length(issues) + 1L]] <- .new_validation_issue( + feature_counts <- .depgraph_count_unique_by(feature_edges$from, feature_edges$to) + fs_ids <- feature_counts$by[feature_counts$n > 1L] + if (length(fs_ids) > 0L) { + samples_by_fs <- split(feature_edges$from, feature_edges$to) + edges_by_fs <- split(feature_edges$edge_id, feature_edges$to) + issues[[length(issues) + 1L]] <- .new_validation_issues( level = "leakage", severity = "advisory", code = "shared_featureset_provenance", - message = paste0("FeatureSet `", featureset_id, "` is shared across multiple samples."), - node_ids = c(featureset_id, linked_samples), - edge_ids = edge_ids + messages = paste0("FeatureSet `", fs_ids, "` is shared across multiple samples."), + node_ids = Map(function(f, samples) c(f, unique(samples)), fs_ids, samples_by_fs[fs_ids]), + edge_ids = edges_by_fs[fs_ids] ) } } @@ -578,22 +627,18 @@ batch_edges <- edge_data[edge_data$edge_type == "sample_processed_in_batch", c("edge_id", "from", "to"), drop = FALSE] n_samples <- sum(node_data$node_type == "Sample") if (nrow(batch_edges) > 0L && n_samples > 0L) { - batch_counts <- stats::aggregate( - batch_edges$from, - by = list(batch = batch_edges$to), - FUN = function(x) length(unique(x)) - ) + batch_counts <- .depgraph_count_unique_by(batch_edges$from, batch_edges$to) threshold <- max(3L, ceiling(n_samples * 0.5)) - heavy <- batch_counts[batch_counts$x >= threshold, , drop = FALSE] - for (i in seq_len(nrow(heavy))) { - batch_id <- heavy$batch[[i]] - issues[[length(issues) + 1L]] <- .new_validation_issue( + batch_ids <- batch_counts$by[batch_counts$n >= threshold] + if (length(batch_ids) > 0L) { + edges_by_batch <- split(batch_edges$edge_id, batch_edges$to) + issues[[length(issues) + 1L]] <- .new_validation_issues( level = "leakage", severity = "advisory", code = "heavy_batch_reuse", - message = paste0("Batch `", batch_id, "` is reused across many samples."), - node_ids = batch_id, - edge_ids = batch_edges$edge_id[batch_edges$to == batch_id] + messages = paste0("Batch `", batch_ids, "` is reused across many samples."), + node_ids = as.list(batch_ids), + edge_ids = edges_by_batch[batch_ids] ) } } @@ -603,19 +648,9 @@ #' @rdname build_dependency_graph #' @export -validate_graph <- function(graph, checks = c("ids", "references", "cardinality", "schema", "time"), error_on_fail = FALSE, levels = NULL, severities = NULL, validation_overrides = NULL) { +validate_graph <- function(graph, error_on_fail = FALSE, levels = NULL, severities = NULL, validation_overrides = NULL) { .depgraph_assert(inherits(graph, "dependency_graph"), "`graph` must be a `dependency_graph`.") - if (!missing(checks)) { - .Deprecated( - msg = paste0( - "The `checks` argument of `validate_graph()` is deprecated. ", - "Use `levels` and `severities` instead." - ), - package = "splitGraph" - ) - } - if (!is.null(validation_overrides)) { .depgraph_assert( is.list(validation_overrides) && (length(validation_overrides) == 0L || @@ -626,18 +661,7 @@ validate_graph <- function(graph, checks = c("ids", "references", "cardinality", graph <- .depgraph_with_overrides(graph, validation_overrides) } - selected_levels <- levels - if (is.null(selected_levels)) { - if (missing(checks)) { - selected_levels <- .depgraph_validation_levels - } else { - selected_levels <- .depgraph_old_checks_to_levels(checks) - if (length(selected_levels) == 0L) { - selected_levels <- .depgraph_validation_levels - } - } - } - selected_levels <- unique(as.character(selected_levels)) + selected_levels <- if (is.null(levels)) .depgraph_validation_levels else unique(as.character(levels)) .depgraph_assert(all(selected_levels %in% .depgraph_validation_levels), "`levels` contains unsupported values.") selected_severities <- if (is.null(severities)) .depgraph_validation_severities else unique(as.character(severities)) @@ -690,36 +714,12 @@ validate_graph <- function(graph, checks = c("ids", "references", "cardinality", ) if (length(all_errors) > 0L && isTRUE(error_on_fail)) { - stop(paste(c("Graph validation failed.", report$errors), collapse = "\n"), call. = FALSE) + .depgraph_stop( + paste(c("Graph validation failed.", report$errors), collapse = "\n"), + class = "splitgraph_validation_error", + code = "graph_validation_failed" + ) } report } - -#' @rdname build_dependency_graph -#' @export -validate_depgraph <- function(graph, checks = c("ids", "references", "cardinality", "schema", "time"), error_on_fail = FALSE, levels = NULL, severities = NULL, validation_overrides = NULL) { - .Deprecated( - new = "validate_graph", - package = "splitGraph", - msg = "`validate_depgraph()` is deprecated. Use `validate_graph()` instead." - ) - if (missing(checks)) { - return(validate_graph( - graph = graph, - error_on_fail = error_on_fail, - levels = levels, - severities = severities, - validation_overrides = validation_overrides - )) - } - - validate_graph( - graph = graph, - checks = checks, - error_on_fail = error_on_fail, - levels = levels, - severities = severities, - validation_overrides = validation_overrides - ) -} diff --git a/README.md b/README.md index 4797005..676f2f9 100644 --- a/README.md +++ b/README.md @@ -98,9 +98,29 @@ The reference consumer is [**bioLeak**](https://github.com/selcukorkmaz/bioLeak) into an executable, leakage-audited split plan. Because `split_spec` is a documented, tool-agnostic contract (with a formal JSON Schema and a Python reference consumer), other tools — an `rsample` adapter, the shipped Python -reader driving scikit-learn — can consume it equally. A contract test -(`Suggests: bioLeak`, skipped if absent) pins this seam so neither side breaks -it silently. +reader driving scikit-learn — can consume it equally. + +What each consumer reads today (verified against the released versions): + +| Consumer | Reads from `split_spec` | Constraint modes accepted | +|---|---|---| +| bioLeak 0.3.8 `as_leaksplits()` | `sample_id`, `group_id`, `batch_group`, `study_group`, `timepoint_id`, `order_rank`; `group_var`, `constraint_mode`, `time_var` | subject, batch, study, time. Every other mode currently **errors** inside bioLeak: site, region, platform, assay, relatedness and spatial are missing from its mode map, and composite maps to a `make_split_plan()` mode whose required arguments the adapter never supplies. Workaround below. | +| Python `splitspec` reader (shipped in `inst/python`) | every field and column, including `stratum` and the block columns | all | +| `rsample` (adapter in the cookbook vignette) | `group_id` for `group_vfold_cv()`, `order_rank` for `rolling_origin()`; block columns read for fold auditing | all | + +Until bioLeak maps the newer modes, any splitGraph grouping still reaches it in +one line: join `group_id` onto your observation frame and call +`make_split_plan()` yourself. + +```r +spec <- as_split_spec(derive_split_constraints(g, mode = "site"), graph = g) +joined <- merge(my_data, spec$sample_data[, c("sample_id", "group_id")], by = "sample_id") +bioLeak::make_split_plan(joined, outcome = "y", mode = "subject_grouped", group = "group_id") +``` + +A contract test (`Suggests: bioLeak`, skipped if absent) pins every row of this +table, including the workaround, so neither side changes it silently; it will +fail, deliberately, when a bioLeak release starts accepting the newer modes. ## Installation @@ -205,6 +225,23 @@ scikit-learn path: vignette("cross-language-handoff", package = "splitGraph") ``` +## Vignettes + +| Vignette | What it covers | +|---|---| +| **Quick start** | Metadata frame to a JSON `split_spec` in ten minutes, with a table for choosing a constraint mode | +| **From metadata to leakage-aware split design** | The full workflow end to end: ingestion, validation, querying, every constraint mode, reshaping and exporting a graph, and the handoff | +| **Modeling site, platform, relatedness, and spatial structure** | The relations added in 0.3.0, thresholded pairwise edges, and combining pairwise with direct relations in one composite | +| **Cross-language handoff** | R to JSON to Python to scikit-learn, including grouped, stratified, and ordered resampling from the spec alone | +| **Adapter cookbook** | Three small adapters: base-R leave-one-group-out, and `rsample` grouped and rolling-origin | +| **Case study: GEO GSE60424** | A real public cohort of 20 donors and seven cell populations, from metadata to a defensible split | +| **FAQ and design notes** | Why not call the downstream planner directly, when composite grouping over-merges, thresholds and transitive closure, schema versioning, and the condition classes | + +```r +vignette(package = "splitGraph") # list them +vignette("quick-start", package = "splitGraph") # start here +``` + ## Core Concepts ### Node types @@ -317,7 +354,8 @@ spec2 <- read_split_spec(spec_path) ``` Both formats have a formal JSON Schema (Draft 2020-12) shipped in -`inst/schema/`, and every written file references it via a `$schema` key. +`inst/schema//`, and every written file references it via a +`$schema` key. Validate a handoff file against the contract with `validate_graph_json()` / `validate_split_spec_json()`. Each file also carries a `schema_version`; the **major** version is the compatibility boundary, so files sharing the @@ -352,15 +390,16 @@ citation("splitGraph") produces: > Korkmaz S (2026). *splitGraph: Dataset Dependency Graphs for -> Leakage-Aware Evaluation*. R package version 0.3.0. +> Leakage-Aware Evaluation*. R package version 0.4.0. > ## Contributing Contributions, bug reports, and questions are welcome. Please see -[`CONTRIBUTING.md`](.github/CONTRIBUTING.md) for how to report issues, seek -support, and submit pull requests, and the -[`CODE_OF_CONDUCT.md`](CODE_OF_CONDUCT.md). Report problems on the +[`CONTRIBUTING.md`](https://github.com/selcukorkmaz/splitGraph/blob/main/.github/CONTRIBUTING.md) +for how to report issues, seek support, and submit pull requests, and the +[`CODE_OF_CONDUCT.md`](https://github.com/selcukorkmaz/splitGraph/blob/main/CODE_OF_CONDUCT.md). +Report problems on the [issue tracker](https://github.com/selcukorkmaz/splitGraph/issues). ## License diff --git a/ROADMAP-0.4.0.md b/ROADMAP-0.4.0.md new file mode 100644 index 0000000..66ffd8b --- /dev/null +++ b/ROADMAP-0.4.0.md @@ -0,0 +1,401 @@ +# splitGraph 0.4.0 — Roadmap + +> **Implementation status (last verified 2026-09-16, version `0.4.0`).** +> Milestones M1–M5 are implemented. M6 (release) is prepared: the version is +> bumped to `0.4.0`, NEWS is dated, and the full release checklist in +> `dev/release.md` has been run locally. What remains is outside this +> repository: pushing the branch, running the pkgdown workflow once so the +> DESCRIPTION URL resolves, and the CRAN submission itself. +> Verified state after implementation: 211 tests, 0 failures, **0 skips** — +> bioLeak 0.3.8 was installed on 2026-09-16, so the contract tests now run and +> `R CMD check` is clean without `_R_CHECK_FORCE_SUGGESTS_=false`; +> covr 91.1 % (gate 90 %); +> all seven vignettes' code executes; every derivation, validation, and JSON +> output identical to CRAN 0.3.0 on regression cohorts except the intended +> additions (stratum column, cross-site rule, edge_sources, schema 0.3.0). +> Measured after M1: composite derivation with the default `via` 0.05 s at +> 5 000 and 0.19 s at 20 000 samples (was ≈ 70 s at 500); enrichment +> (`as_split_spec(graph=)`) 0.1–0.3 s at 5 000 (was 27 s); validation +> ≈ 0.7–1.4 s at 5 000 and ≈ 2–4 s at 20 000; +> build ≈ 1–1.4 s at 5 000 and ≈ 2–5 s at 20 000; graph JSON write 1.4–1.7 s +> at 5 000 and ≈ 6 s at 20 000 (jsonlite-bound). Every step is linear; the +> "< 10 s at 50 000 for the full pipeline" exit target is therefore *not* yet +> met for build + validate + write combined (≈ 30–40 s extrapolated), while +> grouping and enrichment are far inside it. +> +> Also verified on 2026-09-16, once pandoc and the optional packages were +> installed: `R CMD check --as-cran` with vignettes rebuilt (1 WARNING and +> 2 NOTEs, all environmental or version-string related, itemised in +> `dev/release.md`); `lintr::lint_package()` 0 findings after calibrating +> `.lintr` and rewrapping 8 over-long lines; the pkgdown site builds (72 +> pages, all 7 articles) into `pkgdown-site/`; and a reverse-dependency run of +> bioLeak 0.3.8's own suite against this tree passes (281 tests, 0 failures). +> +> Not done in this tree and deliberately left for the maintainer: D2 (bioLeak +> release), D4 publication to PyPI (`pyproject.toml` is ready), the `styler` +> pass (styler not installed), the first pkgdown **deployment** (workflow now +> committed; the DESCRIPTION URL 404s until it runs once), and the CRAN +> submission itself (M6, see `dev/release.md`). The working tree was normalised +> to LF line endings so a tarball built on Windows is clean. An independent review of the implementation +> (2026-09-15) found no high-severity defects; its two medium findings +> (`validation_overrides` serialised as `[]`, `add_edges()` on an empty edge +> set) and four low ones were fixed the same day. A follow-up verification pass +> (2026-09-16) closed the remaining cases of the same two classes: the JSON +> validators could not tell an empty array from an empty object (so they could +> not have caught the `[]` bug themselves), `split_spec()` metadata had the +> same empty-array problem, and `direction =` / `mode =` on the query functions +> still raised bare `match.arg()` errors. Installing bioLeak 0.3.8 the same day +> then corrected the consumer table itself: composite mode fails there too, so +> the documented interim path is now `make_split_plan(group = "group_id")`. +> Gates after that pass: 211 tests, 0 failures, 0 warnings, 0 skips; +> `R CMD check` OK with every Suggests installed; coverage 91.1 %; all seven +> vignettes execute; nothing the package writes fails its own validator. + +**Theme:** Make splitGraph a *mature* representation layer: fast enough for real +cohorts, complete enough that the `split_spec` contract is self-contained, and +clean enough that the 0.1-era API debt is gone. 0.3.0 broadened *what* splitGraph +can describe; 0.4.0 makes describing it dependable at scale. Nothing here produces +folds, fits models, applies purge/embargo, or audits performance — those remain +**bioLeak's** responsibility. + +**Release shape:** one deliberate breaking release. Every removal and rename lands +here so that 0.4.x → 1.0 can be additive. Released as `0.4.0`. + +**Starting point (2026-09-14):** 0.3.0 on CRAN; development tree has the post-release +fixes (factor identifier coercion, tolerant enrichment, JSON array shape, +`dependency_constraint` removed) with 168 tests, 0 failures, and `R CMD check` +`Status: OK` — with local caveats: it was run with `_R_CHECK_FORCE_SUGGESTS_=false` +because bioLeak is not installed here, so **four** tests skip under a plain run — the +three bioLeak contract tests (exercised only in CI) and the Python conformance test, +which skips wherever `NOT_CRAN` is unset (it passes here when run with +`NOT_CRAN=true`; see E2). Vignettes were not built because pandoc is absent; all four +vignettes' code chunks were executed separately via `knitr::purl` and pass. + +--- + +## What "mature" means for this release (exit criteria) + +| Dimension | Today | 0.4.0 target | +|---|---|---| +| Scale | composite derivation with the **default** `via` is quadratic: ≈ 70 s at only 500 samples, ≈ 3.5 min at 750; restricted to subject+batch it is ≈ 5 min at 5 000; validation ≈ 3–7 s at 5 000 depending on the run (7.3 s in the tabulated run) | full pipeline (build → validate → derive → spec → write) < 10 s at 50 000 samples; every step ≤ O(n log n) or O(n + m) | +| Contract | `split_spec` lacks a stratum column; pairwise modes cannot join a composite; reader does not validate | self-contained spec (group, block, order, **stratum**); any relation composable; opt-in schema validation on read | +| API | 5 deprecated aliases + deprecated `checks=` still exported; no graph editing; export only via JSON or by dropping to `as_igraph()` | deprecated surface removed; `subset_graph()`, `combine_graphs()`, `export_graph()`; typed error conditions | +| Consumers | one adapter (bioLeak) reading the 0.2.0 field subset and **erroring** on the six 0.3.0 modes; stale fastml mention | documented, tested consumer matrix; bioLeak reads the full contract (bioLeak-side release) | +| Quality | coverage measured only in CI; no pkgdown; no perf regression guard | coverage ≥ 90 % with local tooling; pkgdown site; benchmark script + budgeted perf test | +| Docs | 4 vignettes (the long end-to-end one doubles as the introduction); all examples synthetic | short quick-start with a mode decision table + real public-dataset case study + FAQ on "why not `make_split_plan()`" | + +--- + +## Guardrails (unchanged) + +| splitGraph *does* | splitGraph *does not* (bioLeak / fastml own) | +|---|---| +| Model dependency structure as a typed graph | Generate resamples / folds | +| Validate structure; derive split **constraints** | Stratified **splitting**, purge/embargo **execution** | +| Emit + validate the `split_spec` interchange format | Model fitting, tuning, performance auditing | +| Carry annotations (group, block, order, stratum) | rsample / tidymodels adapters | +| Cross-language handoff (R ↔ JSON ↔ Python) | Statistical leakage evidence | + +A *stratum* column is an annotation (which outcome level a sample carries), not a +stratified split; it stays on this side of the line. + +--- + +## Workstream A — Performance & scalability (P0, blocking) + +Measured on the development tree (single core, Windows, R 4.5.1; synthetic cohort +with subjects ≈ n/3, batches ≈ n/50, 5 studies, 8 sites, 4 timepoints). The composite +column below is for `via = c("subject", "batch")` only: + +| n | build | validate | derive subject | derive composite (subject+batch) | as_split_spec(graph=) | write graph | +|---|---|---|---|---|---|---| +| 500 | 0.2 s | 0.4 s | 0.4 s | 11.6 s | 1.7 s | 0.5 s | +| 2 000 | 0.6 s | 1.7 s | 1.6 s | 78 s | 9.5 s | 2.1 s | +| 5 000 | 1.5 s | 7.3 s | 5.4 s | **297 s** | 27 s | 7.3 s | + +With the **default** `via` (subject, batch, study, time) on the same cohort the picture +is far worse, because a target shared by n/5 samples (a study) or n/4 samples (a +timepoint) yields O(n²) sample pairs: + +| n | derive composite (default `via`) | +|---|---| +| 250 | 16.5 s | +| 500 | 70.4 s | +| 750 | ≈ 208 s (independent re-run) | + +That is exponent ≈ 2.1: at 5 000 samples the default call would take hours, not +minutes. The subject+batch column grows ≈ n^1.4 only because those targets are small +and bounded. Validation growth is milder and varies between runs (n^1.3–1.6). Profiling +(n = 1 500 and 5 000) attributes the cost to row-at-a-time construction, not to igraph: + +- **A1. Composite / component derivation.** `.depgraph_shared_dependency_table()` + enumerates every sample pair per shared target with `utils::combn()` and builds one + `data.frame` per pair; `.depgraph_shared_dependency_edge_ids()` then rescans the whole + edge table once per pair (O(pairs × edges) always, not just in a worst case). At + n = 1 500 the split was roughly 3:1 between the two (≈ 73 % / 27 %); at n = 500 an + independent profile gave ≈ 87 % / 13 %, so treat the ratio as indicative — the two + hotspots are the same at every n. In addition, `detect_dependency_components()` computes the shared table + **twice** per call — once directly and once inside + `.depgraph_project_sample_dependencies()` (confirmed by tracing). Fix: compute + components on the **bipartite sample–target subgraph** directly + (`igraph::components()` on Sample ∪ via-type nodes, then take the Sample + membership) — no pairwise projection is needed for grouping. Keep the projection + table as a result built once and vectorised (`split()` + `merge()`), not per-pair + frames; see the M1 note on keeping `metadata$projection_edges` populated. +- **A2. Direct assignment and sample maps.** `.depgraph_direct_assignment()` and + `.depgraph_build_sample_map()` build one `data.frame` per sample; enrichment calls the + former seven times (six block sources plus the time path). Vectorise with `match()` + over the edge table; construct each sample map in a single `data.frame()` call. +- **A3. Serialisation.** `write_dependency_graph()` / `write_split_spec()` build one + list per row before `toJSON()`. Pass the data frames to jsonlite directly (its default + `dataframe = "rows"` emits the same row objects) with `attrs` pre-converted. Watch + one detail: an empty `attrs` entry must still serialise as `{}` (today forced via a + named empty list), not `[]` — the schema types `attrs` as `object`, so `[]` fails any + external JSON Schema validator. The R-side `validate_graph_json()` would *not* catch + it, because it never inspects `attrs` (see B5), so cover this with a round-trip test. +- **A4. Pairwise helpers.** `spatial_edges_from_coords()` loops over all pairs + (1.8 s at 1 500 points). Use `which(dmat <= radius & upper.tri(dmat), arr.ind = TRUE)`; + for large n offer a neighbour-search backend (`RANN`/`FNN` in Suggests). Accept a + square kinship / GRM **matrix** in `relatedness_edges_from_kinship()` (e.g. PLINK + `--make-rel square` output) in addition to the long pair table it takes today; + KING and GCTA emit pair tables, which the current signature already covers. +- **A5. Validation.** 7.3 s at 5 000 samples in the tabulated run, ≈ 3–7 s across repeat runs (superlinear, n^1.3–1.6), with two causes visible in + the profile: `.validate_structural()` calls `.depgraph_edge_type_schema()` — a + `data.frame` subset — once **per edge**, and every issue becomes a one-row + `data.frame` that is later `rbind`-ed (2 557 issues on the benchmark cohort, mostly + per-subject advisories). Vectorise the signature check with one join against the + schema table, and accumulate issue columns as vectors, building the table once. (A + suspected named-vector `[[` lookup cost was tested and is negligible.) +- **A6. Guard rails.** Add `inst/bench/pipeline.R` (reproduces the table above) and a + `test-performance.R` with a generous wall-clock budget, skipped on CRAN, so a + regression to quadratic behaviour fails CI rather than a user's session. + +Exit: the 50 000-sample budget above; results identical to 0.3.0 on the existing test +fixtures (grouping vectors, component ids up to relabelling, JSON round-trips). + +--- + +## Workstream B — `split_spec` contract completeness + +- **B1. Stratum annotation.** Add `stratum` to `sample_data`, filled from the Outcome + node linked by `sample_has_outcome` (or via `subject_has_outcome`) when exactly one + outcome per sample exists; NA otherwise. Declare `stratum_var` on the spec. The + Python reader's generic `strata(column)` already anticipates this, so scikit-learn's + `StratifiedGroupKFold` can run from the spec alone. bioLeak's `stratify=` still reads + the outcome from the caller's data frame, so on that side `stratum` is a consistency + check rather than a replacement. +- **B2. Any relation composable.** Unify the projection-edge machinery so + `mode = "composite", via = c("subject", "relatedness", "spatial", ...)` works, removing + the limitation documented in 0.3.0.9000. Rule-based strategy gains pairwise sources + as lowest-priority fallbacks. +- **B3. Leakage rules for the 0.3.0 relations.** `.validate_leakage()` and the + `severed` table know nothing about Site, Region, Platform, Assay. One rule is a clear + analogue of an existing one: `subject_cross_site_overlap` (mirrors + `subject_cross_study_overlap`). Further structural rules (e.g. site and study being + one-to-one, so a site holdout is silently a study holdout) should be drafted against + the real-data case study in F2 rather than invented up front; anything that needs + outcome distributions is statistical and belongs to bioLeak. Extend + `.leakage_severed_by_constraint()` for whatever lands. +- **B4. Schema 0.3.0.** B1–B3 add fields → bump `.depgraph_schema_version` to + `"0.3.0"` (same major, additive, loads silently). Publish schemas under a **versioned** + URL path (`inst/schema/0.3.0/…`) so `$schema` references stop drifting with `main`. + ⚠️ `test-schema-version.R` pins `"0.2.0"` and `test-json-schema.R` hard-codes it in + eight places (plus `"0.1.0"` legacy cases that must keep loading); update those + with the bump and add a `0.2.0 → 0.3.0` migration test, as was done for 0.1 → 0.2. +- **B5. Validating reader.** `read_split_spec(path, validate = FALSE)` / + `read_dependency_graph(path, validate = FALSE)`: when `TRUE`, run the shipped + structural validator (and `validate_graph()` for graphs) and error on failure. + Document the default explicitly (already clarified in 0.3.0.9000 docs). While there, + close the known holes in the R-side validators: neither checks `attrs` is an object, + and `validate_split_spec_json()` checks neither the `sample_data` column types nor the + `metadata` vector fields the schema declares. +- **B6. Provenance.** Record thresholds (`kinship_threshold`, `spatial_radius`), `via`, + `priority`, and the `igraph` version in `metadata`. Note the thresholds are applied + when the edge set is built and are *not* known at derivation time today (only the + per-edge metric survives), so the edge-building helpers must first store them on the + `graph_edge_set$source` list and the graph must carry that through. Make the + vector-valued metadata fields (already forced to arrays) explicit in the schema. + +--- + +## Workstream C — API maturity and cleanup (breaking, bundled) + +- **C1. Remove the 0.1-era surface.** `new_depgraph()`, `new_depgraph_nodes()`, + `new_depgraph_edges()`, `build_depgraph()`, `validate_depgraph()`, and the `checks=` + argument of `validate_graph()` have been deprecated since 0.2.0. Remove them; keep a + NEWS migration table. +- **C2. Graph editing.** `subset_graph(g, samples = )` (keep the induced structure for a + sample subset; the composite-strict path already recomputes components within a + subset, but nothing exposes the subgraph itself), `combine_graphs(g1, g2)` (union with + id-collision checks), and `add_edges(g, edge_set)` returning a re-validated graph. + Today users must rebuild from node/edge sets. +- **C3. Export.** `export_graph(g, file, format = c("graphml", "gml", "nodes_csv", + "edges_csv"))` as promised in the v1 blueprint, so graphs open in Cytoscape / Gephi. + This is a thin convenience over the already-exported `as_igraph()` + + `igraph::write_graph()`; its real work is that GraphML attributes must be scalars, so + the `attrs` list-column has to be flattened to typed columns (or dropped with a + message) on export. +- **C4. Typed conditions.** Replace bare `stop()` with classed conditions + (`splitgraph_error`, subclasses `splitgraph_schema_error`, + `splitgraph_reference_error`, `splitgraph_ambiguity_error`) carrying the same `code` + vocabulary as validation issues, so callers can `tryCatch()` on class and the + Python side can map codes. +- **C5. Input adapters (Suggests only).** `graph_from_metadata()` as an S3 generic with + a `SummarizedExperiment` method reading `colData()`; a documented long-format path for + multi-assay samples (one row per sample × assay). +- **C6. Plot focus.** `plot(g, focus = c("full", "sample_projection", "ego"), node =)` + per the blueprint's `visualize_graph()`. All 11 node types already have palette + entries, so the `_other_` colour is reachable only for hand-built graphs carrying an + unknown type; keep it as a defensive default. +- **C7. Consistency sweep.** Identical column order across all emitted frames, and the + `NA`-column conventions of `sample_data` documented once in `?split_spec`. The local + `%||%` is NA-aware and deliberately differs from base R's (≥ 4.4); keep it, but say so + in a comment so nobody "simplifies" it away. + +--- + +## Workstream D — Consumer seam (the deferred gap) + +Recorded 2026-09-14 (corrected after independent review): bioLeak 0.3.8's +`as_leaksplits()` forwards only `group_id`, `batch_group`, `study_group`, +`timepoint_id`, `order_rank`, and its mode map covers only subject / batch / study / +time / composite. For any other `constraint_mode` (site, region, platform, assay, +relatedness, spatial) the lookup `mode_map[[src_mode]]` on a named atomic vector +**errors** with "subscript out of bounds" — the intended `subject_grouped` fallback on +the next line is unreachable. So a 0.3.0-mode spec does not degrade silently; it +cannot be consumed by bioLeak at all today. `make_split_plan()` also has no generic +blocking axis, so the full fix is a bioLeak feature. Local `bioLeak` (0.3.5) and +`fastml` (0.7.8) repos lag CRAN (0.3.8, 0.7.10). + +Corrected again 2026-09-16, after installing bioLeak 0.3.8 and actually running +the seam rather than reading it: the adapter is worse than the static reading +suggested. **`composite` also fails**, in both strategies — it *is* in the mode +map, but maps to `make_split_plan(mode = "combined")` without the +`constraints` / `primary_axis` that mode requires, so it errors with +`'primary_axis' must be a list with 'type' and 'col' elements`. Verified +acceptance is exactly subject / batch / study / time. The interim path that +does work for every other mode is to join `group_id` onto the observation frame +and call `make_split_plan(mode = "subject_grouped", group = "group_id")` +directly; D1 now documents and tests that. + +- **D1 (splitGraph, this release).** Remove the fastml consumer mention in + `R/split-spec.R`; extend `test-bioleak-contract.R` to *pin today's behaviour* (the + four supported modes round-trip; the six 0.3.0 modes and both composite + strategies raise bioLeak's error — `expect_error()`s that will start failing, + deliberately, when D2 ships; and the `group_id` workaround succeeds); document in + `?as_split_spec` and the README exactly which modes and columns the reference consumer + accepts, and suggest `mode = "subject"`/`"composite"` or a manual `group_id` handoff + as the interim path for the new relations. +- **D2 (bioLeak, separate release, after syncing the repo to 0.3.8).** Three + defects to fix, in order: (a) `composite` is mapped but unusable — supply + `constraints` (or `primary_axis` / `secondary_axis`) from the spec's + `metadata$via` when `mode = "combined"`; (b) make the unknown-mode fallback + reachable (`mode_map[src_mode]` / `match()` / `switch`) and map the six new + modes explicitly; (c) forward the four block columns and `stratum`, and + accept a generic `block=` axis in `make_split_plan()`. Then flip the + splitGraph contract test from "expects error" to "asserts blocking is + honoured". +- **D3 (rsample).** Turn the illustrative `group_vfold_cv()` adapter in the cookbook into + an *executed* example under `Suggests: rsample`. No new export — the boundary holds. +- **D4 (Python).** Publish `splitspec` to PyPI as a stdlib-only package with the + conformance script as its test suite; pin the schema major it supports. + +--- + +## Workstream E — Quality infrastructure + +- **E1. Coverage.** Add `covr` to the dev tooling and a `dev/coverage.R` entry; set a + Codecov threshold (fail under 90 %). Measure before targeting: the obvious candidates + (edge dedupe conflicts, partial time ordering, plot layouts) turned out to be covered + already, so the real gaps are only knowable from the report. +- **E2. CI.** Two facts verified 2026-09-14: `setup-r-dependencies` installs Suggests + by default, so the bioLeak contract test already runs in `R-CMD-check` (it gates on + `skip_if_not_installed()`); but neither `check-r-package` nor `rcmdcheck` sets + `NOT_CRAN`, so the Python conformance test — which gates on `skip_on_cran()` — has + **never run in CI**. Fix: set `NOT_CRAN: true` in the workflow `env` (Ubuntu runners + ship `python3`), add the `perf-budget` job running `test-performance.R` under the + same flag, and pin the bioLeak version used by the contract test in the job log so a + CRAN bioLeak release changing the seam is visible. +- **E3. pkgdown.** `_pkgdown.yml` with a grouped reference index (Build · Validate · + Query · Derive · Interchange · Pairwise), deployed via Actions; link from README. +- **E4. Static checks and line endings.** `lintr` config committed; `styler` pass once + (bundled with the breaking release so the diff noise lands in one commit). + `.gitattributes` (`* text=auto`) normalises only the git *index*: on this Windows + checkout 59 tracked files are CRLF in the worktree, and a tarball built here carries + CRLF in most text files (the CRAN 0.3.0 tarball is LF only because it was built on + another machine). `R CMD check` does not flag this. Fix: build release tarballs in CI + (Linux) or set `core.autocrlf=false` + `git add --renormalize .` on the release + machine, and add a tarball line-ending check to the release checklist (E5). +- **E5. Release checklist.** `dev/release.md`: `rhub` multi-platform check, `revdepcheck` + against bioLeak, `urlchecker`, NEWS review, schema version review, `CITATION` bump. + +--- + +## Workstream F — Documentation + +- **F1. Quick start.** The existing `leakage-aware-workflow` vignette already covers the + end-to-end path (it shows the fast path briefly, then does the main walkthrough via + the explicit constructors) but is over 1 100 lines. Add a short + quick-start (metadata frame → JSON `split_spec` via the fast path) with the decision + table "which mode for which structure", and make it the first entry in the index. +- **F2. Real-data case study** vignette: a public multi-batch, multi-site cohort (e.g. a + GEO series with repeated subjects), cached as `inst/extdata`, showing how validation + catches an actual provenance problem and how the derived groups differ between + subject, composite-strict, and rule-based modes. +- **F3. FAQ / design notes**: "Why not `make_split_plan(group=, batch=)` directly?", + "When does composite-strict over-merge?", "How do thresholds interact with transitive + closure?", schema versioning policy in one place. +- **F4. Reference hygiene**: every exported function has a runnable example; every + `sample_data` column documented once with type and NA semantics; node/edge type + cheat-sheet as a table in `?splitGraph`. Fix an existing over-claim while there: the + README's scope table (line 94) already lists "Carrying stratum … annotations" as a + present capability although no stratum column exists until B1 lands — either ship + B1 first or reword the README. +- **F5. Paper alignment**: update `paper.md` claims to match D1 (state exactly what the + reference consumer reads) and cite the performance envelope from A. + +--- + +## Milestones / sequencing + +1. **M1 — Performance (A).** First, because every later workstream adds fields and + tests that would otherwise inherit the superlinear cost. Land with the benchmark and + the budgeted perf test. *Can ship as 0.3.1 if a CRAN patch is wanted early, provided + it stays non-breaking: `detect_dependency_components()` must keep returning + `metadata$projection_edges` and the selected `edges` table, and constraint + `sample_map` columns must not change.* +2. **M2 — Breaking cleanup (C1, C4, C7).** Remove deprecated surface, introduce typed + conditions, consistency sweep. Bundle the `styler` pass here. +3. **M3 — Contract (B, C2, C3, C6).** Stratum, composable pairwise, new leakage rules, + schema 0.3.0 + versioned URLs, validating reader, graph editing, export, and plot + focus (which reuses the projection machinery from A1/B2). +4. **M4 — Seam and interop (D1, D3, D4, C5).** Consumer table, pinned contract test, + executed rsample example, PyPI reader, SummarizedExperiment input. +5. **M5 — Quality and docs (E, F).** Coverage gate, CI jobs, pkgdown, vignettes, FAQ, + paper alignment. +6. **M6 — Release.** Checklist in E5; coordinate the bioLeak-side D2 release so the + contract test can be tightened in 0.4.1 rather than blocking 0.4.0. + +--- + +## Risks / watch-items + +- **Behaviour drift while vectorising.** Component *labels* may change even when the + partition is identical; tests must compare partitions (e.g. via + `igraph::compare(method = "nmi")` or canonical relabelling), not raw `component_k` + strings. Pin the projection table's row order explicitly. +- **Schema bump churn.** B1–B3 are additive (same major); resist any rename. If a field + must change meaning, that is a 1.0 conversation, not 0.4.0. +- **Breaking-change blast radius.** bioLeak is the only known reverse dependency (CRAN + reverse Suggests). Its 0.3.8 sources call **no** splitGraph function at all — the one + mention of `splitGraph::as_split_spec` is inside an error-message string — and read + four `split_spec` fields (`sample_data`, `group_var`, `constraint_mode`, `time_var`) + plus the `sample_id`, `batch_group`, `study_group`, `timepoint_id`, `order_rank` + columns (verified 2026-09-14). C1 is therefore safe, and those names are the ones + that must never change without a coordinated bioLeak release; re-verify against the + bioLeak version current at release. +- **Scope creep from the blueprint's §12.** Gene / Drug / Pathway knowledge-graph + extensions stay out; 0.4.0 is about maturity of the dataset-structure layer. +- **Stratum ≠ stratification.** Keep B1 as an annotation; never balance folds here. +- **Windows tooling.** `python3` on Windows may be a Store stub (handled in tests); + document `python` fallback for contributors. diff --git a/_pkgdown.yml b/_pkgdown.yml new file mode 100644 index 0000000..9dc4a55 --- /dev/null +++ b/_pkgdown.yml @@ -0,0 +1,85 @@ +url: https://selcukorkmaz.github.io/splitGraph/ + +# `docs/` already holds the v1 design blueprint, so the generated site goes to +# its own directory (git-ignored and build-ignored); the pkgdown workflow +# deploys that folder to the gh-pages branch. +destination: pkgdown-site + +template: + bootstrap: 5 + bslib: + primary: "#4C78A8" + +home: + title: "splitGraph: dataset dependency graphs for leakage-aware evaluation" + +navbar: + structure: + left: [intro, reference, articles, news] + right: [search, github] + components: + intro: + text: Quick start + href: articles/quick-start.html + articles: + text: Articles + menu: + - text: Quick start + href: articles/quick-start.html + - text: From metadata to leakage-aware split design + href: articles/leakage-aware-workflow.html + - text: Modeling site, platform, relatedness, and spatial structure + href: articles/modeling-structure.html + - text: Cross-language handoff (R -> JSON -> Python) + href: articles/cross-language-handoff.html + - text: Adapter cookbook + href: articles/adapter-cookbook.html + - text: "Case study: GEO GSE60424" + href: articles/case-study-gse60424.html + - text: FAQ and design notes + href: articles/faq-design-notes.html + +reference: + - title: Build + desc: Ingest sample metadata and assemble a typed dependency graph. + contents: + - graph_from_metadata + - ingest_metadata + - create_nodes + - build_dependency_graph + - graph_node_set + - graph_edit + - title: Validate + desc: Structural, semantic, and leakage-relevant checks, and the conditions the package raises. + contents: + - depgraph_validation_report + - splitgraph_conditions + - title: Query + desc: Inspect neighbourhoods, paths, shared dependencies, and dependency components. + contents: + - query_node_type + - title: Derive + desc: Turn graph structure into deterministic split constraints. + contents: + - derive_split_constraints + - pairwise_edges + - title: Interchange + desc: The tool-agnostic `split_spec`, JSON serialisation, schema validation, and migration. + contents: + - as_split_spec + - write_split_spec + - write_dependency_graph + - validate_json + - migrate_json + - title: Visualise and export + contents: + - plot.dependency_graph + - export_graph + - title: Package + contents: + - splitGraph-package + +news: + releases: + - text: "Version 0.3.0" + href: https://github.com/selcukorkmaz/splitGraph/blob/main/NEWS.md diff --git a/cran-comments.md b/cran-comments.md new file mode 100644 index 0000000..c2d0e1b --- /dev/null +++ b/cran-comments.md @@ -0,0 +1,85 @@ +# cran-comments.md — splitGraph 0.4.0 + +This is an update of an existing CRAN package (0.3.0, published 2026-07-03). + +## Resubmission + +This is a resubmission. The previous 0.4.0 tarball failed CRAN's incoming +pre-test with 1 ERROR and 1 NOTE on both r-devel-linux-x86_64-debian-gcc and +r-devel-windows-x86_64. Both are fixed: + +* **ERROR, `checking tests`** — `test-export.R:37` failed inside igraph's GML + writer with "Size of id vector must match vertex count" (`io/gml.c:1057`). + `export_graph(format = "gml")` called `igraph::write_graph()` without an `id` + argument; on the igraph version present on the check machines, that `NULL` + default reaches the C layer as a zero-length vector and is rejected. The + writer is now given explicit node ids (`seq_len(vcount)`), which is what it + would otherwise have generated and which every igraph version accepts. The + test now also asserts one `id` line per node, so a regression cannot pass + silently. + + This did not reproduce locally on igraph 2.2.1, where the same call succeeds. + +* **NOTE, invalid file URIs from README.md** — the README linked to + `.github/CONTRIBUTING.md` and `CODE_OF_CONDUCT.md` with relative paths. Both + files are build-ignored, so the links dangled inside the installed package. + They are now absolute GitHub URLs. The only relative link left in README.md + is `man/figures/README-plot-1.png`, which does ship in the tarball. + +## Test environments + +* Local: Windows 11 x64, R 4.5.1 (2025-06-13 ucrt), igraph 2.2.1 — + `R CMD check --as-cran` on the built tarball: 1 WARNING, 3 NOTEs, all local to + that machine (see below). +* win-builder r-devel and r-release, and r-devel-linux-x86_64-debian-gcc, via + CRAN's incoming pre-test for the previous submission. + +## R CMD check results + +The local run reports 0 errors | 1 warning | 3 notes. All four are caused by +tooling absent from the checking machine rather than by the package, and none +appeared on CRAN's own systems: + +* WARNING `'qpdf' is needed for checks on size reduction of PDFs` — qpdf is not + installed locally. +* NOTE `unable to verify current time` — the checking machine could not reach a + time server. +* NOTE `Skipping checking HTML validation: no command 'tidy' found` — HTML Tidy + is not installed locally. +* NOTE `detritus in the temp directory: 'lastMiKTeXException'` — a file left by + MiKTeX, unrelated to this package. + +`checking CRAN incoming feasibility` passes locally, and +`urlchecker::url_check()` reports all URLs in the package as valid. + +A spell check (`spelling::spell_check_package()`) flags exactly one word in +DESCRIPTION: **inspectable**. It is correctly spelled, and it appears in the +same position in the Description field of version 0.3.0, which is on CRAN. + +## Reverse dependencies + +CRAN lists one reverse dependency: **bioLeak** (Suggests only; no reverse +depends, imports, or linking-to). CRAN's own pre-test reported "No strong +reverse dependencies to be checked." + +This release contains breaking changes (removal of aliases deprecated in 0.2.0, +and of two constructors that were exported but never produced or consumed by the +package). bioLeak was checked against this version specifically: + +* bioLeak uses none of the removed API. Its only integration point is + `R/splitgraph_adapter.R`, which reads `spec$sample_data`, `spec$group_var`, + `spec$constraint_mode` and `spec$time_var` — all unchanged in 0.4.0. +* No bioLeak test loads splitGraph, so its suite is unaffected. +* splitGraph ships a contract test (`tests/testthat/test-bioleak-contract.R`) + that pins this boundary and passes against the installed bioLeak 0.3.8. + +## Notes for the maintainers + +* `Suggests: SummarizedExperiment` is a Bioconductor package. It is used by a + single S3 method, which guards it with `requireNamespace()`. No example uses + it; the one test that does calls `skip_if_not_installed()`, and the one + vignette chunk is conditional on `requireNamespace()`. The package therefore + checks cleanly without Bioconductor present. +* The package ships a small pure-Python reference reader under `inst/python/`. + It is data, not compiled or executed at build or check time; the one test that + runs it is skipped on CRAN. diff --git a/dev/coverage.R b/dev/coverage.R new file mode 100644 index 0000000..0ec8573 --- /dev/null +++ b/dev/coverage.R @@ -0,0 +1,32 @@ +# Local test coverage report (mirrors .github/workflows/test-coverage.yaml). +# +# Rscript dev/coverage.R # summary per file + total, fails below 90 % +# Rscript dev/coverage.R report # also opens the interactive HTML report +# +# Requires covr (install.packages("covr")). NOT_CRAN is set so the +# skip_on_cran() tests (Python conformance, performance budget) are included; +# set SPLITGRAPH_SKIP_PERF=true to leave the budget test out on a slow machine. + +if (!requireNamespace("covr", quietly = TRUE)) { + stop("covr is not installed: install.packages('covr')", call. = FALSE) +} + +Sys.setenv(NOT_CRAN = "true") +threshold <- 90 + +cov <- covr::package_coverage(".", type = "tests", quiet = TRUE) +by_file <- covr::coverage_to_list(cov)$filecoverage +total <- covr::percent_coverage(cov) + +cat("\nCoverage by file (%):\n") +print(round(sort(by_file), 1)) +cat(sprintf("\nTOTAL: %.1f %% (threshold %d %%)\n", total, threshold)) + +if (identical(commandArgs(trailingOnly = TRUE), "report")) { + covr::report(cov) +} + +if (total < threshold) { + stop(sprintf("Coverage %.1f %% is below the %d %% threshold.", total, threshold), call. = FALSE) +} +invisible(cov) diff --git a/dev/paper-figure.R b/dev/paper-figure.R new file mode 100644 index 0000000..1e2c581 --- /dev/null +++ b/dev/paper-figure.R @@ -0,0 +1,83 @@ +# Generates the data-flow figure used in paper.md (JOSS submission). +# +# Rscript dev/paper-figure.R +# +# Writes paper-figures/paper-pipeline.png. Base graphics only, so the figure is +# reproducible from a bare R installation with no extra dependencies. + +out <- file.path("paper-figures", "paper-pipeline.png") +dir.create(dirname(out), showWarnings = FALSE, recursive = TRUE) + +png(out, width = 2200, height = 900, res = 210) +op <- par(mar = c(0, 0, 0, 0), xaxs = "i", yaxs = "i") +on.exit({ par(op); dev.off() }, add = TRUE) + +plot(NA, xlim = c(0, 100), ylim = c(0, 39), axes = FALSE, xlab = "", ylab = "") + +col_in <- "#E8EEF4" +col_core <- "#4C78A8" +col_out <- "#54A24B" +col_side <- "#F4F4F4" +edge_col <- "#31465F" + +box <- function(x, w, y, h, label, sub = NULL, fill, text_col = "black", + cex = 0.70, sub_cex = 0.60) { + rect(x, y, x + w, y + h, col = fill, border = edge_col, lwd = 1.4) + if (is.null(sub)) { + text(x + w / 2, y + h / 2, label, col = text_col, cex = cex, font = 2) + } else { + text(x + w / 2, y + h * 0.66, label, col = text_col, cex = cex, font = 2) + text(x + w / 2, y + h * 0.30, sub, col = text_col, cex = sub_cex) + } +} + +# Pipeline geometry: five boxes of width `bw` separated by gaps of width `gw`, +# wide enough for a two-line function label to sit above each arrow. +bw <- 12.6 +gw <- 8.5 +x0 <- 1.5 +xs <- x0 + (0:4) * (bw + gw) +ytop <- 23 +ht <- 12 +ymid <- ytop + ht / 2 + +step <- function(i, label) { + a <- xs[i] + bw + b <- xs[i + 1] + arrows(a + 0.4, ymid, b - 0.4, ymid, length = 0.065, lwd = 1.6, col = edge_col) + text((a + b) / 2, ymid + 3.6, label[1], cex = 0.55, col = edge_col, font = 3) + text((a + b) / 2, ymid + 1.9, label[2], cex = 0.55, col = edge_col, font = 3) +} + +box(xs[1], bw, ytop, ht, "metadata table", "one row per sample", col_in) +box(xs[2], bw, ytop, ht, "dependency_graph", "11 node types, 17 relations", + col_core, text_col = "white", sub_cex = 0.55) +box(xs[3], bw, ytop, ht, "split_constraint", "one group per sample", col_out) +box(xs[4], bw, ytop, ht, "split_spec", "declared roles + rows", col_out) +box(xs[5], bw, ytop, ht, "JSON", "schema-versioned", col_out) + +step(1, c("graph_from_", "metadata()")) +step(2, c("derive_split_", "constraints()")) +step(3, c("as_split_", "spec()")) +step(4, c("write_split_", "spec()")) + +# Validation hangs off the graph, not off the pipeline. +vx <- xs[2] + bw / 2 +arrows(vx, ytop - 0.4, vx, 14.4, length = 0.065, lwd = 1.6, col = edge_col) +text(vx + 0.8, 18.2, "validate_graph()", cex = 0.55, col = edge_col, + font = 3, pos = 4) +box(xs[2] - 3.6, bw + 7.2, 2.4, 12, "validation report", + "structural / semantic / leakage", col_side, sub_cex = 0.55) + +# Everything past the JSON artifact belongs to a consumer, not to splitGraph. +cx <- xs[5] + bw / 2 +arrows(cx, ytop - 0.4, cx, 14.4, length = 0.065, lwd = 1.6, col = edge_col) +segments(77.5, 18.2, 98.5, 18.2, lty = 3, lwd = 1.6, col = "#B03A2E") +text(88.0, 19.9, "splitGraph stops here", cex = 0.56, + col = "#B03A2E", font = 3) +box(77.5, 21.0, 2.4, 12, "consumers", + "bioLeak (R)\nsplitspec + scikit-learn (Python)", fill = "#FFFFFF", + sub_cex = 0.55) + +par(op) +message("wrote ", out) diff --git a/dev/release.md b/dev/release.md new file mode 100644 index 0000000..0e3d96c --- /dev/null +++ b/dev/release.md @@ -0,0 +1,102 @@ +# splitGraph release checklist + +Run through this list, in order, for every CRAN release. Items marked *(CI)* +are also enforced by GitHub Actions; run them locally anyway before tagging. + +## 1. Code and contract + +- [ ] `NEWS.md` has a dated section for the release; every user-visible change + in `git diff ..HEAD` is mentioned. Breaking changes carry a + migration table. +- [ ] `DESCRIPTION` `Version:` is the release version (no `.9000`). +- [ ] `.depgraph_schema_version` is correct for the on-disk contract: + - unchanged if no `split_spec` / `dependency_graph` field was added, + - bumped in the MINOR position for additive changes (same MAJOR: old + files still load silently), + - bumped in MAJOR only if an old file would become unreadable — and then + `migrate_*_json()` and the Python reader's `_SUPPORTED_MAJORS` must + follow. +- [ ] If the schema version changed: `inst/schema//` exists with both + schema files, their `$id` points at the versioned path, the pinned strings + in `tests/testthat/test-schema-version.R` and `test-json-schema.R` are + updated, and a ` -> ` migration test exists. +- [ ] `inst/python/pyproject.toml` `version` tracks the schema version; the + reader handles every field the schema declares. +- [ ] `?as_split_spec` "What downstream consumers read" and the README seam + section still describe the current bioLeak release (check the tarball's + `R/splitgraph_adapter.R`); `test-bioleak-contract.R` matches it. + +## 2. Local checks + +- [ ] `Rscript -e 'roxygen2::roxygenise()'` leaves no diff. +- [ ] `NOT_CRAN=true Rscript -e 'testthat::test_local()'` — 0 failures; the + Python conformance test and the performance budget both *ran* (not + skipped). *(CI)* +- [ ] `Rscript dev/coverage.R` ≥ 90 %. *(CI: test-coverage)* +- [ ] `Rscript inst/bench/pipeline.R 500 2000 5000 20000` — every step scales + linearly; note the numbers in NEWS if they changed materially. +- [ ] `R CMD build .` then `R CMD check --as-cran splitGraph_.tar.gz`. + Install every Suggests first (bioLeak, SummarizedExperiment, rsample, + jsonlite, knitr, rmarkdown) so nothing is skipped; do not reach for + `_R_CHECK_FORCE_SUGGESTS_=false`, which hides those tests. + *(CI: R-CMD-check, 5 platforms)* +- [ ] Known `--as-cran` output on a developer machine, and what each means: + - `'qpdf' is needed for checks on size reduction of PDFs` — WARNING, + environmental. Install qpdf, or accept it: CRAN's machines have it. + - `Version contains large components` — NOTE, only while the version is + `*.9000`. It disappears once bumped to the release version. + - `Files 'README.md' or 'NEWS.md' cannot be checked without 'pandoc'` — + NOTE. Put pandoc on PATH (`install.packages("pandoc"); + pandoc::pandoc_install()` gives one, but export its directory on PATH + for the check subprocess, not just `RSTUDIO_PANDOC`). + - DESCRIPTION's `URL` deliberately lists **only** the GitHub repository. + The pkgdown site URL was removed for the 0.4.0 submission because it + 404s until the site is deployed, and CRAN's incoming check rejects + that. Once the `pkgdown` workflow has run and Pages is enabled, add + `https://selcukorkmaz.github.io/splitGraph/` back to `URL` and + re-roxygenise. `_pkgdown.yml` keeps its own `url:` either way, so the + site builds correctly in the meantime. +- [ ] `Rscript -e 'lintr::lint_package()'` reports 0 findings (the committed + `.lintr` is calibrated so it is a real gate, not noise). +- [ ] pkgdown site builds: `pkgdown::build_site(install = FALSE)` with the + package installed in a library on the path. Output goes to + `pkgdown-site/` (git-ignored), not `docs/`, which holds the design + blueprint. +- [ ] Vignettes build (pandoc required) or, without pandoc, every vignette's + code executes: `Rscript -e 'for (v in list.files("vignettes", "[.]Rmd$", full.names=TRUE)) { f <- tempfile(fileext=".R"); knitr::purl(v, f, quiet=TRUE, documentation=0); source(f, echo=FALSE) }'`. +- [ ] `urlchecker::url_check()` clean. +- [ ] `lintr::lint_package()` reports nothing new. + +## 3. Line endings and the tarball + +- [ ] Build the release tarball on Linux (CI) or, on Windows, verify no CRLF + leaked in: `tar -xzf splitGraph_.tar.gz && grep -rlI $'\r' splitGraph/ | head` must print nothing. + `.gitattributes` normalises only the git index, not the working tree. +- [ ] The tarball contains no `MD5` (CRAN adds it), no `docs/`, `dev/`, + `ROADMAP-*.md`, `paper.*`, `_pkgdown.yml`, `.lintr`, `inst/python/__pycache__`. + +## 4. Reverse dependencies + +- [ ] `revdepcheck::revdep_check()`, or manually: install this splitGraph into a + temporary library, then run bioLeak's own test suite against it. Last run + 2026-09-16 against bioLeak 0.3.8: 281 tests, 0 failures, 3 skipped. + Also run splitGraph's own suite with `NOT_CRAN=true` and bioLeak present; + the contract tests must pass and must not skip. +- [ ] Multi-platform: `rhub::rhub_check()` on at least Windows, macOS, and + Linux devel. + +## 5. Ship + +- [ ] Push the branch and let the `pkgdown` workflow finish. This no longer + blocks submission -- the site URL is out of DESCRIPTION as of 0.4.0 -- but + the site should exist before the release is announced. After Pages is + live, put the URL back in DESCRIPTION, re-roxygenise, and confirm with + `urlchecker::url_check(".")` that it resolves. +- [ ] `inst/CITATION` and the README citation block name the new version. + (CITATION reads `meta[["Version"]]`, so it follows DESCRIPTION; the README + block is hand-written and must be edited.) +- [ ] `git tag v`; push tag after CRAN acceptance. +- [ ] Bump `DESCRIPTION` to `.9000` and open a + `# splitGraph (development version)` section in NEWS. +- [ ] If the bioLeak seam changed (Workstream D2), coordinate the bioLeak + release and then flip the pinned contract test. diff --git a/inst/.DS_Store b/inst/.DS_Store deleted file mode 100644 index 9e128af..0000000 Binary files a/inst/.DS_Store and /dev/null differ diff --git a/inst/bench/pipeline.R b/inst/bench/pipeline.R new file mode 100644 index 0000000..978b8dd --- /dev/null +++ b/inst/bench/pipeline.R @@ -0,0 +1,59 @@ +# Benchmark the core splitGraph pipeline on a synthetic cohort. +# +# Usage (from the package root, after installing or with pkgload): +# Rscript inst/bench/pipeline.R # default sizes +# Rscript inst/bench/pipeline.R 500 5000 # custom sizes +# +# Cohort shape (matches ROADMAP-0.4.0.md, Workstream A): subjects ~ n/3 with +# repeated samples, batches ~ n/50, 5 studies, 8 sites, 4 timepoints with a +# numeric time_index. Every step is timed once; the composite step is timed +# twice, with the default `via` (subject, batch, study, time) and with +# `via = c("subject", "batch")`, because the two differ in how many samples +# share a target. + +if (!requireNamespace("splitGraph", quietly = TRUE)) { + pkgload::load_all(".", quiet = TRUE) +} else { + library(splitGraph) +} + +sizes <- as.integer(commandArgs(trailingOnly = TRUE)) +if (length(sizes) == 0L) sizes <- c(500L, 2000L, 5000L) + +make_cohort <- function(n, seed = 1L) { + set.seed(seed) + meta <- data.frame( + sample_id = paste0("S", seq_len(n)), + subject_id = paste0("P", sample(ceiling(n / 3), n, replace = TRUE)), + batch_id = paste0("B", sample(ceiling(n / 50), n, replace = TRUE)), + study_id = paste0("ST", sample(5L, n, replace = TRUE)), + site_id = paste0("Site", sample(8L, n, replace = TRUE)), + timepoint_id = paste0("T", sample(4L, n, replace = TRUE)), + stringsAsFactors = FALSE + ) + meta$time_index <- as.integer(sub("T", "", meta$timepoint_id)) + meta +} + +time_it <- function(expr) round(unname(system.time(expr)[["elapsed"]]), 2) + +bench_one <- function(n) { + meta <- make_cohort(n) + out <- c(n = n) + out["build"] <- time_it(g <- graph_from_metadata(meta, validate = FALSE)) + out["validate"] <- time_it(validate_graph(g)) + out["derive_subject"] <- time_it(con <- derive_split_constraints(g, "subject")) + out["composite_default"] <- time_it(derive_split_constraints(g, "composite")) + out["composite_subj_bat"] <- time_it(derive_split_constraints(g, "composite", via = c("subject", "batch"))) + out["as_split_spec"] <- time_it(spec <- as_split_spec(con, graph = g)) + out["write_graph"] <- time_it(write_dependency_graph(g, tempfile(fileext = ".json"))) + out["write_spec"] <- time_it(write_split_spec(spec, tempfile(fileext = ".json"))) + out["shared_deps_subject"] <- time_it(detect_shared_dependencies(g, via = "Subject")) + out +} + +results <- do.call(rbind, lapply(sizes, bench_one)) +cat("\nsplitGraph", as.character(utils::packageVersion("splitGraph")), + "| R", R.version$major, ".", R.version$minor, "| seconds (elapsed)\n\n", sep = "") +print(results) +invisible(results) diff --git a/inst/extdata/GSE60424_README.md b/inst/extdata/GSE60424_README.md new file mode 100644 index 0000000..7bcfd72 --- /dev/null +++ b/inst/extdata/GSE60424_README.md @@ -0,0 +1,38 @@ +# GSE60424_samples.csv + +Sample-level metadata (no expression values) for GEO series +[GSE60424](https://www.ncbi.nlm.nih.gov/geo/query/acc.cgi?acc=GSE60424): +RNA-seq of whole blood and six sorted immune cell populations from 20 donors +(healthy controls; type 1 diabetes; amyotrophic lateral sclerosis; sepsis; +multiple sclerosis). 134 samples. Used by `vignette("case-study-gse60424")`. + +## Provenance + +- Retrieved 2026-09-14 with `GEOquery::getGEO("GSE60424", GSEMatrix = TRUE, + getGPL = FALSE)`; only `Biobase::pData()` of the series matrix was kept. +- The `characteristics_ch1.*` columns were split on the first `:` into + key/value pairs. Columns kept and renamed: + +| Column | Source field | Notes | +|---|---|---| +| `geo_accession` | `geo_accession` | GSM id | +| `sample_id` | `samplename` | e.g. `44_Tempus`; unique | +| `subject_id` | `donorid` | prefixed with `D` | +| `cell_type` | `celltype` | B-cells, CD4, CD8, Monocytes, Neutrophils, NK, Whole Blood | +| `disease_status` | `diseasestatus` | as recorded, including "MS pretreatment" / "MS posttreatment" | +| `condition` | derived | `disease_status` with the MS pre/post suffix removed (5 levels) | +| `timepoint_id`, `time_index` | derived | `pre_treatment` / `post_treatment` for MS, else `baseline`. **Not** a repeated-measure axis: the pre- and post-treatment MS samples come from different donors. Kept only so the vignette can show why they should not be modelled as timepoints. | +| `collection_date` | `collectiondate` | as recorded, e.g. `June 26 2012` | +| `batch_id` | derived | `collection_date` as ISO `YYYY-MM-DD`; one date per donor | +| `sex` | `gender` | `F`, `M`, or NA | +| `library_index` | `index` | sequencing library index | + +- Rows are sorted by `subject_id`, `cell_type`, `timepoint_id`. +- Month names were mapped explicitly (not via the locale) when deriving + `batch_id`. + +## Terms + +GEO data are public. The metadata here are reproduced solely to demonstrate +dataset-structure modelling; consult the GEO record and its linked publication +for the study itself, and cite the accession when reusing these values. diff --git a/inst/extdata/GSE60424_samples.csv b/inst/extdata/GSE60424_samples.csv new file mode 100644 index 0000000..1e26974 --- /dev/null +++ b/inst/extdata/GSE60424_samples.csv @@ -0,0 +1,135 @@ +"geo_accession","sample_id","subject_id","cell_type","disease_status","collection_date","sex","library_index","condition","timepoint_id","time_index","batch_id" +"GSM1479501","20_Bcells","D20","B-cells","Healthy Control","January 25 2012","F","4","Healthy Control","baseline",0,"2012-01-25" +"GSM1479502","20_CD4T","D20","CD4","Healthy Control","January 25 2012","F","5","Healthy Control","baseline",0,"2012-01-25" +"GSM1479503","20_CD8T","D20","CD8","Healthy Control","January 25 2012","F","27","Healthy Control","baseline",0,"2012-01-25" +"GSM1479500","20_Monocytes","D20","Monocytes","Healthy Control","January 25 2012","F","2","Healthy Control","baseline",0,"2012-01-25" +"GSM1479499","20_Neutrophils","D20","Neutrophils","Healthy Control","January 25 2012","F","1","Healthy Control","baseline",0,"2012-01-25" +"GSM1479504","20_NK","D20","NK","Healthy Control","January 25 2012","F","11","Healthy Control","baseline",0,"2012-01-25" +"GSM1479505","20_Tempus","D20","Whole Blood","Healthy Control","January 25 2012","F","6","Healthy Control","baseline",0,"2012-01-25" +"GSM1479508","21_Bcells","D21","B-cells","Healthy Control","February 2 2012","F","7","Healthy Control","baseline",0,"2012-02-02" +"GSM1479509","21_CD4T","D21","CD4","Healthy Control","February 2 2012","F","12","Healthy Control","baseline",0,"2012-02-02" +"GSM1479510","21_CD8T","D21","CD8","Healthy Control","February 2 2012","F","13","Healthy Control","baseline",0,"2012-02-02" +"GSM1479507","21_Monocytes","D21","Monocytes","Healthy Control","February 2 2012","F","3","Healthy Control","baseline",0,"2012-02-02" +"GSM1479506","21_Neutrophils","D21","Neutrophils","Healthy Control","February 2 2012","F","21","Healthy Control","baseline",0,"2012-02-02" +"GSM1479511","21_NK","D21","NK","Healthy Control","February 2 2012","F","14","Healthy Control","baseline",0,"2012-02-02" +"GSM1479512","21_Tempus","D21","Whole Blood","Healthy Control","February 2 2012","F","20","Healthy Control","baseline",0,"2012-02-02" +"GSM1479446","31_Bcells","D31","B-cells","MS pretreatment","May 21 2012","F","3","MS","pre_treatment",0,"2012-05-21" +"GSM1479447","31_CD4T","D31","CD4","MS pretreatment","May 21 2012","F","5","MS","pre_treatment",0,"2012-05-21" +"GSM1479448","31_CD8T","D31","CD8","MS pretreatment","May 21 2012","F","8","MS","pre_treatment",0,"2012-05-21" +"GSM1479445","31_Monocytes","D31","Monocytes","MS pretreatment","May 21 2012","F","4","MS","pre_treatment",0,"2012-05-21" +"GSM1479444","31_Neutrophils","D31","Neutrophils","MS pretreatment","May 21 2012","F","1","MS","pre_treatment",0,"2012-05-21" +"GSM1479434","31_Tempus","D31","Whole Blood","MS pretreatment","May 21 2012","F","2","MS","pre_treatment",0,"2012-05-21" +"GSM1479451","33_Bcells","D33","B-cells","MS posttreatment","May 22 2012","F","7","MS","post_treatment",1,"2012-05-22" +"GSM1479452","33_CD4T","D33","CD4","MS posttreatment","May 22 2012","F","11","MS","post_treatment",1,"2012-05-22" +"GSM1479453","33_CD8T","D33","CD8","MS posttreatment","May 22 2012","F","12","MS","post_treatment",1,"2012-05-22" +"GSM1479450","33_Monocytes","D33","Monocytes","MS posttreatment","May 22 2012","F","10","MS","post_treatment",1,"2012-05-22" +"GSM1479449","33_Neutrophils","D33","Neutrophils","MS posttreatment","May 22 2012","F","6","MS","post_treatment",1,"2012-05-22" +"GSM1479435","33_Tempus","D33","Whole Blood","MS posttreatment","May 22 2012","F","9","MS","post_treatment",1,"2012-05-22" +"GSM1479456","34_Bcells","D34","B-cells","Type 1 Diabetes","May 23 2012","F","21","Type 1 Diabetes","baseline",0,"2012-05-23" +"GSM1479457","34_CD4T","D34","CD4","Type 1 Diabetes","May 23 2012","F","15","Type 1 Diabetes","baseline",0,"2012-05-23" +"GSM1479458","34_CD8T","D34","CD8","Type 1 Diabetes","May 23 2012","F","22","Type 1 Diabetes","baseline",0,"2012-05-23" +"GSM1479455","34_Monocytes","D34","Monocytes","Type 1 Diabetes","May 23 2012","F","14","Type 1 Diabetes","baseline",0,"2012-05-23" +"GSM1479454","34_Neutrophils","D34","Neutrophils","Type 1 Diabetes","May 23 2012","F","20","Type 1 Diabetes","baseline",0,"2012-05-23" +"GSM1479459","34_NK","D34","NK","Type 1 Diabetes","May 23 2012","F","16","Type 1 Diabetes","baseline",0,"2012-05-23" +"GSM1479436","34_Tempus","D34","Whole Blood","Type 1 Diabetes","May 23 2012","F","13","Type 1 Diabetes","baseline",0,"2012-05-23" +"GSM1479462","37_Bcells","D37","B-cells","Type 1 Diabetes","June 6 2012","F","19","Type 1 Diabetes","baseline",0,"2012-06-06" +"GSM1479463","37_CD4T","D37","CD4","Type 1 Diabetes","June 6 2012","F","27","Type 1 Diabetes","baseline",0,"2012-06-06" +"GSM1479464","37_CD8T","D37","CD8","Type 1 Diabetes","June 6 2012","F","20","Type 1 Diabetes","baseline",0,"2012-06-06" +"GSM1479461","37_Monocytes","D37","Monocytes","Type 1 Diabetes","June 6 2012","F","25","Type 1 Diabetes","baseline",0,"2012-06-06" +"GSM1479460","37_Neutrophils","D37","Neutrophils","Type 1 Diabetes","June 6 2012","F","18","Type 1 Diabetes","baseline",0,"2012-06-06" +"GSM1479437","37_Tempus","D37","Whole Blood","Type 1 Diabetes","June 6 2012","F","23","Type 1 Diabetes","baseline",0,"2012-06-06" +"GSM1479536","40_Bcells","D40","B-cells","Type 1 Diabetes","June 19 2012","M","11","Type 1 Diabetes","baseline",0,"2012-06-19" +"GSM1479537","40_CD4T","D40","CD4","Type 1 Diabetes","June 19 2012","M","5","Type 1 Diabetes","baseline",0,"2012-06-19" +"GSM1479538","40_CD8T","D40","CD8","Type 1 Diabetes","June 19 2012","M","27","Type 1 Diabetes","baseline",0,"2012-06-19" +"GSM1479535","40_Monocytes","D40","Monocytes","Type 1 Diabetes","June 19 2012","M","2","Type 1 Diabetes","baseline",0,"2012-06-19" +"GSM1479534","40_Neutrophils","D40","Neutrophils","Type 1 Diabetes","June 19 2012","M","1","Type 1 Diabetes","baseline",0,"2012-06-19" +"GSM1479539","40_Tempus","D40","Whole Blood","Type 1 Diabetes","June 19 2012","M","4","Type 1 Diabetes","baseline",0,"2012-06-19" +"GSM1479542","41_Bcells","D41","B-cells","Type 1 Diabetes","June 20 2012","F","3","Type 1 Diabetes","baseline",0,"2012-06-20" +"GSM1479543","41_CD4T","D41","CD4","Type 1 Diabetes","June 20 2012","F","7","Type 1 Diabetes","baseline",0,"2012-06-20" +"GSM1479544","41_CD8T","D41","CD8","Type 1 Diabetes","June 20 2012","F","9","Type 1 Diabetes","baseline",0,"2012-06-20" +"GSM1479541","41_Monocytes","D41","Monocytes","Type 1 Diabetes","June 20 2012","F","21","Type 1 Diabetes","baseline",0,"2012-06-20" +"GSM1479540","41_Neutrophils","D41","Neutrophils","Type 1 Diabetes","June 20 2012","F","6","Type 1 Diabetes","baseline",0,"2012-06-20" +"GSM1479545","41_NK","D41","NK","Type 1 Diabetes","June 20 2012","F","13","Type 1 Diabetes","baseline",0,"2012-06-20" +"GSM1479546","41_Tempus","D41","Whole Blood","Type 1 Diabetes","June 20 2012","F","14","Type 1 Diabetes","baseline",0,"2012-06-20" +"GSM1479467","43_Bcells","D43","B-cells","Sepsis","June 22 2012","M","3","Sepsis","baseline",0,"2012-06-22" +"GSM1479468","43_CD4T","D43","CD4","Sepsis","June 22 2012","M","4","Sepsis","baseline",0,"2012-06-22" +"GSM1479469","43_CD8T","D43","CD8","Sepsis","June 22 2012","M","13","Sepsis","baseline",0,"2012-06-22" +"GSM1479466","43_Monocytes","D43","Monocytes","Sepsis","June 22 2012","M","2","Sepsis","baseline",0,"2012-06-22" +"GSM1479465","43_Neutrophils","D43","Neutrophils","Sepsis","June 22 2012","M","1","Sepsis","baseline",0,"2012-06-22" +"GSM1479470","43_NK","D43","NK","Sepsis","June 22 2012","M","20","Sepsis","baseline",0,"2012-06-22" +"GSM1479471","43_Tempus","D43","Whole Blood","Sepsis","June 22 2012","M","5","Sepsis","baseline",0,"2012-06-22" +"GSM1479440","44_Bcells","D44","B-cells","Healthy Control","June 26 2012","F","6","Healthy Control","baseline",0,"2012-06-26" +"GSM1479441","44_CD4T","D44","CD4","Healthy Control","June 26 2012","F","25","Healthy Control","baseline",0,"2012-06-26" +"GSM1479442","44_CD8T","D44","CD8","Healthy Control","June 26 2012","F","12","Healthy Control","baseline",0,"2012-06-26" +"GSM1479439","44_Monocytes","D44","Monocytes","Healthy Control","June 26 2012","F","23","Healthy Control","baseline",0,"2012-06-26" +"GSM1479438","44_Neutrophils","D44","Neutrophils","Healthy Control","June 26 2012","F","5","Healthy Control","baseline",0,"2012-06-26" +"GSM1479443","44_NK","D44","NK","Healthy Control","June 26 2012","F","19","Healthy Control","baseline",0,"2012-06-26" +"GSM1479433","44_Tempus","D44","Whole Blood","Healthy Control","June 26 2012","F","21","Healthy Control","baseline",0,"2012-06-26" +"GSM1479487","45_Bcells","D45","B-cells","MS pretreatment","June 28 2012","F","18","MS","pre_treatment",0,"2012-06-28" +"GSM1479488","45_CD4T","D45","CD4","MS pretreatment","June 28 2012","F","10","MS","pre_treatment",0,"2012-06-28" +"GSM1479489","45_CD8T","D45","CD8","MS pretreatment","June 28 2012","F","19","MS","pre_treatment",0,"2012-06-28" +"GSM1479486","45_Monocytes","D45","Monocytes","MS pretreatment","June 28 2012","F","23","MS","pre_treatment",0,"2012-06-28" +"GSM1479485","45_Neutrophils","D45","Neutrophils","MS pretreatment","June 28 2012","F","16","MS","pre_treatment",0,"2012-06-28" +"GSM1479490","45_NK","D45","NK","MS pretreatment","June 28 2012","F","4","MS","pre_treatment",0,"2012-06-28" +"GSM1479491","45_Tempus","D45","Whole Blood","MS pretreatment","June 28 2012","F","9","MS","pre_treatment",0,"2012-06-28" +"GSM1479494","46_Bcells","D46","B-cells","MS posttreatment","June 29 2012","F","25","MS","post_treatment",1,"2012-06-29" +"GSM1479495","46_CD4T","D46","CD4","MS posttreatment","June 29 2012","F","27","MS","post_treatment",1,"2012-06-29" +"GSM1479496","46_CD8T","D46","CD8","MS posttreatment","June 29 2012","F","11","MS","post_treatment",1,"2012-06-29" +"GSM1479493","46_Monocytes","D46","Monocytes","MS posttreatment","June 29 2012","F","7","MS","post_treatment",1,"2012-06-29" +"GSM1479492","46_Neutrophils","D46","Neutrophils","MS posttreatment","June 29 2012","F","22","MS","post_treatment",1,"2012-06-29" +"GSM1479497","46_NK","D46","NK","MS posttreatment","June 29 2012","F","1","MS","post_treatment",1,"2012-06-29" +"GSM1479498","46_Tempus","D46","Whole Blood","MS posttreatment","June 29 2012","F","27","MS","post_treatment",1,"2012-06-29" +"GSM1479474","49_Bcells","D49","B-cells","Sepsis","July 5 2012","F","7","Sepsis","baseline",0,"2012-07-05" +"GSM1479475","49_CD4T","D49","CD4","Sepsis","July 5 2012","F","12","Sepsis","baseline",0,"2012-07-05" +"GSM1479476","49_CD8T","D49","CD8","Sepsis","July 5 2012","F","3","Sepsis","baseline",0,"2012-07-05" +"GSM1479473","49_Monocytes","D49","Monocytes","Sepsis","July 5 2012","F","8","Sepsis","baseline",0,"2012-07-05" +"GSM1479472","49_Neutrophils","D49","Neutrophils","Sepsis","July 5 2012","F","6","Sepsis","baseline",0,"2012-07-05" +"GSM1479477","49_Tempus","D49","Whole Blood","Sepsis","July 5 2012","F","21","Sepsis","baseline",0,"2012-07-05" +"GSM1479480","50_Bcells","D50","B-cells","Sepsis","July 6 2012","F","9","Sepsis","baseline",0,"2012-07-06" +"GSM1479481","50_CD4T","D50","CD4","Sepsis","July 6 2012","F","2","Sepsis","baseline",0,"2012-07-06" +"GSM1479482","50_CD8T","D50","CD8","Sepsis","July 6 2012","F","14","Sepsis","baseline",0,"2012-07-06" +"GSM1479479","50_Monocytes","D50","Monocytes","Sepsis","July 6 2012","F","13","Sepsis","baseline",0,"2012-07-06" +"GSM1479478","50_Neutrophils","D50","Neutrophils","Sepsis","July 6 2012","F","22","Sepsis","baseline",0,"2012-07-06" +"GSM1479483","50_NK","D50","NK","Sepsis","July 6 2012","F","15","Sepsis","baseline",0,"2012-07-06" +"GSM1479484","50_Tempus","D50","Whole Blood","Sepsis","July 6 2012","F","16","Sepsis","baseline",0,"2012-07-06" +"GSM1479515","52_Bcells","D52","B-cells","ALS","August 16 2012",NA,"8","ALS","baseline",0,"2012-08-16" +"GSM1479516","52_CD4T","D52","CD4","ALS","August 16 2012",NA,"15","ALS","baseline",0,"2012-08-16" +"GSM1479517","52_CD8T","D52","CD8","ALS","August 16 2012",NA,"6","ALS","baseline",0,"2012-08-16" +"GSM1479514","52_Monocytes","D52","Monocytes","ALS","August 16 2012",NA,"22","ALS","baseline",0,"2012-08-16" +"GSM1479513","52_Neutrophils","D52","Neutrophils","ALS","August 16 2012",NA,"14","ALS","baseline",0,"2012-08-16" +"GSM1479518","52_NK","D52","NK","ALS","August 16 2012",NA,"16","ALS","baseline",0,"2012-08-16" +"GSM1479519","52_Tempus","D52","Whole Blood","ALS","August 16 2012",NA,"15","ALS","baseline",0,"2012-08-16" +"GSM1479522","53_Bcells","D53","B-cells","Healthy Control","August 21 2012","F","23","Healthy Control","baseline",0,"2012-08-21" +"GSM1479523","53_CD4T","D53","CD4","Healthy Control","August 21 2012","F","9","Healthy Control","baseline",0,"2012-08-21" +"GSM1479524","53_CD8T","D53","CD8","Healthy Control","August 21 2012","F","19","Healthy Control","baseline",0,"2012-08-21" +"GSM1479521","53_Monocytes","D53","Monocytes","Healthy Control","August 21 2012","F","18","Healthy Control","baseline",0,"2012-08-21" +"GSM1479520","53_Neutrophils","D53","Neutrophils","Healthy Control","August 21 2012","F","18","Healthy Control","baseline",0,"2012-08-21" +"GSM1479525","53_NK","D53","NK","Healthy Control","August 21 2012","F","11","Healthy Control","baseline",0,"2012-08-21" +"GSM1479526","53_Tempus","D53","Whole Blood","Healthy Control","August 21 2012","F","8","Healthy Control","baseline",0,"2012-08-21" +"GSM1479529","54_Bcells","D54","B-cells","ALS","August 22 2012",NA,"20","ALS","baseline",0,"2012-08-22" +"GSM1479530","54_CD4T","D54","CD4","ALS","August 22 2012",NA,"25","ALS","baseline",0,"2012-08-22" +"GSM1479531","54_CD8T","D54","CD8","ALS","August 22 2012",NA,"10","ALS","baseline",0,"2012-08-22" +"GSM1479528","54_Monocytes","D54","Monocytes","ALS","August 22 2012",NA,"5","ALS","baseline",0,"2012-08-22" +"GSM1479527","54_Neutrophils","D54","Neutrophils","ALS","August 22 2012",NA,"10","ALS","baseline",0,"2012-08-22" +"GSM1479532","54_NK","D54","NK","ALS","August 22 2012",NA,"21","ALS","baseline",0,"2012-08-22" +"GSM1479533","54_Tempus","D54","Whole Blood","ALS","August 22 2012",NA,"12","ALS","baseline",0,"2012-08-22" +"GSM1479549","55_Bcells","D55","B-cells","MS pretreatment","August 23 2012","F","22","MS","pre_treatment",0,"2012-08-23" +"GSM1479550","55_CD4T","D55","CD4","MS pretreatment","August 23 2012","F","8","MS","pre_treatment",0,"2012-08-23" +"GSM1479551","55_CD8T","D55","CD8","MS pretreatment","August 23 2012","F","15","MS","pre_treatment",0,"2012-08-23" +"GSM1479548","55_Monocytes","D55","Monocytes","MS pretreatment","August 23 2012","F","14","MS","pre_treatment",0,"2012-08-23" +"GSM1479547","55_Neutrophils","D55","Neutrophils","MS pretreatment","August 23 2012","F","20","MS","pre_treatment",0,"2012-08-23" +"GSM1479552","55_Tempus","D55","Whole Blood","MS pretreatment","August 23 2012","F","6","MS","pre_treatment",0,"2012-08-23" +"GSM1479555","56_Bcells","D56","B-cells","MS posttreatment","August 24 2012","F","10","MS","post_treatment",1,"2012-08-24" +"GSM1479556","56_CD4T","D56","CD4","MS posttreatment","August 24 2012","F","21","MS","post_treatment",1,"2012-08-24" +"GSM1479557","56_CD8T","D56","CD8","MS posttreatment","August 24 2012","F","23","MS","post_treatment",1,"2012-08-24" +"GSM1479554","56_Monocytes","D56","Monocytes","MS posttreatment","August 24 2012","F","15","MS","post_treatment",1,"2012-08-24" +"GSM1479553","56_Neutrophils","D56","Neutrophils","MS posttreatment","August 24 2012","F","16","MS","post_treatment",1,"2012-08-24" +"GSM1479558","56_NK","D56","NK","MS posttreatment","August 24 2012","F","9","MS","post_treatment",1,"2012-08-24" +"GSM1479559","56_Tempus","D56","Whole Blood","MS posttreatment","August 24 2012","F","19","MS","post_treatment",1,"2012-08-24" +"GSM1479562","58_Bcells","D58","B-cells","ALS","September 12 2012",NA,"11","ALS","baseline",0,"2012-09-12" +"GSM1479563","58_CD4T","D58","CD4","ALS","September 12 2012",NA,"5","ALS","baseline",0,"2012-09-12" +"GSM1479564","58_CD8T","D58","CD8","ALS","September 12 2012",NA,"20","ALS","baseline",0,"2012-09-12" +"GSM1479561","58_Monocytes","D58","Monocytes","ALS","September 12 2012",NA,"8","ALS","baseline",0,"2012-09-12" +"GSM1479560","58_Neutrophils","D58","Neutrophils","ALS","September 12 2012",NA,"12","ALS","baseline",0,"2012-09-12" +"GSM1479565","58_NK","D58","NK","ALS","September 12 2012",NA,"25","ALS","baseline",0,"2012-09-12" +"GSM1479566","58_Tempus","D58","Whole Blood","ALS","September 12 2012",NA,"10","ALS","baseline",0,"2012-09-12" diff --git a/inst/python/README.md b/inst/python/README.md index fac5966..c90d9f9 100644 --- a/inst/python/README.md +++ b/inst/python/README.md @@ -21,7 +21,25 @@ spec = load_split_spec("split_spec.json") spec.grouping() # {sample_id: group_id}, == R grouping_vector() spec.groups() # group_id per sample, for GroupKFold(groups=...) spec.order_ranks() # order_rank per sample, for TimeSeriesSplit +spec.strata() # stratum per sample (spec.stratum_var), for StratifiedGroupKFold(y=...) spec.to_frame() # pandas DataFrame of sample_data + +for train_idx, test_idx in spec.stratified_group_kfold(n_splits=5): + ... # grouped on group_id, stratified on the stratum annotation +``` + +`stratum_var` / `stratum` were added in schema 0.3.0 (splitGraph 0.4.0); files +written by earlier versions load with `spec.stratum_var is None` and +`spec.strata()` returning `None` for every sample. The reader accepts every +schema with major version 0. + +## Installing as a package + +`pyproject.toml` in this directory packages the reader as `splitspec`: + +```bash +pip install # reader only +pip install "[sklearn]" # + scikit-learn helpers ``` In R, locate this directory with: diff --git a/inst/python/conformance.py b/inst/python/conformance.py index 4ddfeb8..efe0a11 100644 --- a/inst/python/conformance.py +++ b/inst/python/conformance.py @@ -26,6 +26,8 @@ def main(in_path, out_path): "n_samples": len(spec.sample_data), "grouping": spec.grouping(), "order_ranks": dict(zip(spec.sample_ids, spec.order_ranks())), + "stratum_var": spec.stratum_var, + "strata": dict(zip(spec.sample_ids, spec.strata())), } with open(out_path, "w", encoding="utf-8") as handle: json.dump(result, handle) diff --git a/inst/python/pyproject.toml b/inst/python/pyproject.toml new file mode 100644 index 0000000..67fa41d --- /dev/null +++ b/inst/python/pyproject.toml @@ -0,0 +1,32 @@ +[build-system] +requires = ["setuptools>=61"] +build-backend = "setuptools.build_meta" + +[project] +name = "splitspec" +version = "0.3.0" +description = "Pure-Python reader for the splitGraph split_spec JSON interchange format (schema major 0)." +readme = "README.md" +requires-python = ">=3.8" +license = { text = "MIT" } +authors = [{ name = "Selcuk Korkmaz", email = "selcukorkmaz@gmail.com" }] +keywords = ["cross-validation", "data-leakage", "biomedical", "splitGraph", "scikit-learn"] +classifiers = [ + "Programming Language :: Python :: 3", + "License :: OSI Approved :: MIT License", + "Intended Audience :: Science/Research", + "Topic :: Scientific/Engineering :: Bio-Informatics", +] +# The reader itself needs only the standard library. +dependencies = [] + +[project.optional-dependencies] +pandas = ["pandas>=1.0"] +sklearn = ["scikit-learn>=1.0", "numpy"] + +[project.urls] +Homepage = "https://github.com/selcukorkmaz/splitGraph" +Schema = "https://raw.githubusercontent.com/selcukorkmaz/splitGraph/main/inst/schema/0.3.0/split_spec.schema.json" + +[tool.setuptools] +packages = ["splitspec"] diff --git a/inst/python/splitspec/__init__.py b/inst/python/splitspec/__init__.py index 60836dd..91cb858 100644 --- a/inst/python/splitspec/__init__.py +++ b/inst/python/splitspec/__init__.py @@ -11,4 +11,4 @@ from .reader import SplitSpec, load_split_spec __all__ = ["SplitSpec", "load_split_spec"] -__version__ = "0.2.0" +__version__ = "0.3.0" diff --git a/inst/python/splitspec/reader.py b/inst/python/splitspec/reader.py index 270809f..c7793b4 100644 --- a/inst/python/splitspec/reader.py +++ b/inst/python/splitspec/reader.py @@ -41,6 +41,8 @@ def __init__(self, data): self.group_var = data.get("group_var", "group_id") self.block_vars = list(data.get("block_vars") or []) self.time_var = data.get("time_var") + # Added in schema 0.3.0; older files simply have no stratum annotation. + self.stratum_var = data.get("stratum_var") self.ordering_required = bool(data.get("ordering_required")) self.constraint_mode = data.get("constraint_mode") self.constraint_strategy = data.get("constraint_strategy") @@ -70,8 +72,17 @@ def order_ranks(self): """ return [row.get("order_rank") for row in self.sample_data] - def strata(self, column): - """Stratum annotation from ``column`` (e.g. a block variable).""" + def strata(self, column=None): + """Stratum annotation per sample, in file order. + + ``column`` defaults to the spec's ``stratum_var`` (the outcome level + each sample carries, added in schema 0.3.0); pass any other column + name, e.g. a block variable, to stratify on that instead. Returns a + list of ``None`` when neither is available. + """ + column = column or self.stratum_var + if column is None: + return [None] * len(self.sample_data) return [row.get(column) for row in self.sample_data] def grouping(self): @@ -113,6 +124,27 @@ def group_kfold(self, n_splits=5): X = np.zeros((n, 1)) return GroupKFold(n_splits=n_splits).split(X, groups=self.groups()) + def stratified_group_kfold(self, n_splits=5, column=None, **kwargs): + """Yield ``(train_idx, test_idx)`` from ``sklearn.StratifiedGroupKFold``. + + Keyed on the grouping vector and stratified on :meth:`strata` + (``stratum_var`` by default). Raises ``ValueError`` when the spec has + no stratum annotation for some sample. Needs scikit-learn and numpy. + """ + import numpy as np + from sklearn.model_selection import StratifiedGroupKFold + + strata = self.strata(column) + if any(s is None for s in strata): + raise ValueError( + "StratifiedGroupKFold needs a stratum for every sample; the spec's " + "stratum annotation is missing for some rows (or stratum_var is null)." + ) + n = len(self.sample_data) + X = np.zeros((n, 1)) + splitter = StratifiedGroupKFold(n_splits=n_splits, **kwargs) + return splitter.split(X, y=strata, groups=self.groups()) + def load_split_spec(path): """Read a ``split_spec`` JSON file and return a :class:`SplitSpec`.""" diff --git a/inst/schema/dependency_graph.schema.json b/inst/schema/0.3.0/dependency_graph.schema.json similarity index 71% rename from inst/schema/dependency_graph.schema.json rename to inst/schema/0.3.0/dependency_graph.schema.json index 02148fe..00f85ec 100644 --- a/inst/schema/dependency_graph.schema.json +++ b/inst/schema/0.3.0/dependency_graph.schema.json @@ -1,8 +1,8 @@ { "$schema": "https://json-schema.org/draft/2020-12/schema", - "$id": "https://raw.githubusercontent.com/selcukorkmaz/splitGraph/main/inst/schema/dependency_graph.schema.json", + "$id": "https://raw.githubusercontent.com/selcukorkmaz/splitGraph/main/inst/schema/0.3.0/dependency_graph.schema.json", "title": "splitGraph dependency_graph", - "description": "On-disk JSON format written by splitGraph::write_dependency_graph(). A typed dependency graph describing biomedical dataset structure.", + "description": "On-disk JSON format written by splitGraph::write_dependency_graph(). A typed dependency graph describing biomedical dataset structure. Schema version 0.3.0 (package 0.4.0): adds metadata.edge_sources. Additive over 0.2.0.", "type": "object", "required": ["splitGraph_object", "schema_version", "nodes", "edges"], "properties": { @@ -16,7 +16,21 @@ "dataset_name": { "type": ["string", "null"] }, "created_at": { "type": ["string", "null"] }, "schema_version": { "type": "string" }, - "validation_overrides": { "type": "object" } + "validation_overrides": { "type": "object" }, + "edge_sources": { + "type": "object", + "description": "Provenance of each edge set that went into the graph, keyed by relation (edge_type). Records the source columns and, for thresholded pairwise relations, the threshold that was applied when the edges were built (kinship minimum for subject_related_to, distance maximum for sample_adjacent_to).", + "additionalProperties": { + "type": "object", + "properties": { + "relation": { "type": "string" }, + "from_col": { "type": ["string", "null"] }, + "to_col": { "type": ["string", "null"] }, + "threshold": { "type": ["number", "null"] }, + "metric": { "type": ["string", "null"] } + } + } + } } }, "nodes": { diff --git a/inst/schema/0.3.0/split_spec.schema.json b/inst/schema/0.3.0/split_spec.schema.json new file mode 100644 index 0000000..41ec0aa --- /dev/null +++ b/inst/schema/0.3.0/split_spec.schema.json @@ -0,0 +1,94 @@ +{ + "$schema": "https://json-schema.org/draft/2020-12/schema", + "$id": "https://raw.githubusercontent.com/selcukorkmaz/splitGraph/main/inst/schema/0.3.0/split_spec.schema.json", + "title": "splitGraph split_spec", + "description": "On-disk JSON format written by splitGraph::write_split_spec(). A tool-agnostic, sample-level split specification for leakage-aware evaluation. Schema version 0.3.0 (package 0.4.0): adds stratum_var, sample_data[].stratum, and richer metadata provenance. Additive over 0.2.0.", + "type": "object", + "required": ["splitGraph_object", "schema_version", "group_var", "sample_data"], + "properties": { + "$schema": { "type": "string" }, + "splitGraph_object": { "const": "split_spec" }, + "schema_version": { "type": "string", "pattern": "^[0-9]+\\.[0-9]+\\.[0-9]+$" }, + "group_var": { + "type": "string", + "description": "Name of the sample_data column holding the primary grouping (normally group_id)." + }, + "block_vars": { + "type": "array", + "items": { "type": "string" }, + "description": "sample_data columns that carry blocking annotations (batch_group, study_group, site_group, region_group, platform_group, assay_group). Empty when none apply." + }, + "time_var": { + "type": ["string", "null"], + "description": "sample_data column holding the ordering rank (order_rank), or null when no ordering was derived." + }, + "stratum_var": { + "type": ["string", "null"], + "description": "sample_data column holding the stratum annotation (stratum), or null when no outcome is attached to the samples. A stratum is an annotation of the outcome level each sample carries, not a stratified split." + }, + "ordering_required": { "type": "boolean" }, + "constraint_mode": { "type": ["string", "null"] }, + "constraint_strategy": { "type": ["string", "null"] }, + "recommended_resampling": { "type": ["string", "null"] }, + "metadata": { + "type": "object", + "description": "Derivation provenance. Vector-valued fields are always arrays, even with one element.", + "properties": { + "graph_name": { "type": ["string", "null"] }, + "dataset_name": { "type": ["string", "null"] }, + "source_mode": { "type": ["string", "null"] }, + "source_strategy": { "type": ["string", "null"] }, + "relations_used": { "type": "array", "items": { "type": "string" } }, + "via": { + "type": "array", + "items": { "type": "string" }, + "description": "Composite derivations only: dependency sources combined (node types for direct relations, mode names for pairwise relations)." + }, + "priority": { + "type": "array", + "items": { "type": "string" }, + "description": "Rule-based composite derivations only: the priority order of modes." + }, + "threshold": { + "type": ["number", "null"], + "description": "Pairwise derivations only: the threshold applied when the edges were built (kinship minimum or distance maximum), when the graph recorded it." + }, + "threshold_metric": { "type": ["string", "null"] }, + "splitgraph_version": { "type": ["string", "null"] }, + "igraph_version": { "type": ["string", "null"] }, + "derived_at": { "type": ["string", "null"] }, + "n_samples": { "type": "integer" }, + "n_groups": { "type": "integer" }, + "warnings": { "type": "array", "items": { "type": "string" } }, + "enriched_from_graph": { "type": "boolean" }, + "enrichment_warnings": { "type": "array", "items": { "type": "string" } } + } + }, + "sample_data": { + "type": "array", + "items": { "$ref": "#/$defs/sample_row" } + } + }, + "$defs": { + "sample_row": { + "type": "object", + "required": ["sample_id", "group_id"], + "properties": { + "sample_id": { "type": "string" }, + "sample_node_id": { "type": ["string", "null"] }, + "group_id": { "type": "string" }, + "primary_group": { "type": ["string", "null"] }, + "batch_group": { "type": ["string", "null"] }, + "study_group": { "type": ["string", "null"] }, + "site_group": { "type": ["string", "null"] }, + "region_group": { "type": ["string", "null"] }, + "platform_group": { "type": ["string", "null"] }, + "assay_group": { "type": ["string", "null"] }, + "stratum": { "type": ["string", "null"] }, + "timepoint_id": { "type": ["string", "null"] }, + "time_index": { "type": ["number", "null"] }, + "order_rank": { "type": ["integer", "null"] } + } + } + } +} diff --git a/inst/schema/split_spec.schema.json b/inst/schema/split_spec.schema.json deleted file mode 100644 index 1cb6b35..0000000 --- a/inst/schema/split_spec.schema.json +++ /dev/null @@ -1,62 +0,0 @@ -{ - "$schema": "https://json-schema.org/draft/2020-12/schema", - "$id": "https://raw.githubusercontent.com/selcukorkmaz/splitGraph/main/inst/schema/split_spec.schema.json", - "title": "splitGraph split_spec", - "description": "On-disk JSON format written by splitGraph::write_split_spec(). A tool-agnostic, sample-level split specification for leakage-aware evaluation.", - "type": "object", - "required": ["splitGraph_object", "schema_version", "group_var", "sample_data"], - "properties": { - "$schema": { "type": "string" }, - "splitGraph_object": { "const": "split_spec" }, - "schema_version": { "type": "string", "pattern": "^[0-9]+\\.[0-9]+\\.[0-9]+$" }, - "group_var": { "type": "string" }, - "block_vars": { - "type": "array", - "items": { "type": "string" } - }, - "time_var": { "type": ["string", "null"] }, - "ordering_required": { "type": "boolean" }, - "constraint_mode": { "type": ["string", "null"] }, - "constraint_strategy": { "type": ["string", "null"] }, - "recommended_resampling": { "type": ["string", "null"] }, - "metadata": { - "type": "object", - "description": "Derivation provenance: source_mode, source_strategy, relations_used, splitgraph_version, derived_at, n_samples, n_groups, warnings.", - "properties": { - "source_mode": { "type": ["string", "null"] }, - "source_strategy": { "type": ["string", "null"] }, - "relations_used": { - "type": "array", - "items": { "type": "string" } - }, - "splitgraph_version": { "type": ["string", "null"] }, - "derived_at": { "type": ["string", "null"] } - } - }, - "sample_data": { - "type": "array", - "items": { "$ref": "#/$defs/sample_row" } - } - }, - "$defs": { - "sample_row": { - "type": "object", - "required": ["sample_id", "group_id"], - "properties": { - "sample_id": { "type": "string" }, - "sample_node_id": { "type": ["string", "null"] }, - "group_id": { "type": "string" }, - "primary_group": { "type": ["string", "null"] }, - "batch_group": { "type": ["string", "null"] }, - "study_group": { "type": ["string", "null"] }, - "site_group": { "type": ["string", "null"] }, - "region_group": { "type": ["string", "null"] }, - "platform_group": { "type": ["string", "null"] }, - "assay_group": { "type": ["string", "null"] }, - "timepoint_id": { "type": ["string", "null"] }, - "time_index": { "type": ["number", "null"] }, - "order_rank": { "type": ["integer", "null"] } - } - } - } -} diff --git a/man/as_split_spec.Rd b/man/as_split_spec.Rd index 436c4a1..5db52e5 100644 --- a/man/as_split_spec.Rd +++ b/man/as_split_spec.Rd @@ -42,16 +42,37 @@ leakage risks. \details{ The translation layer always produces canonical sample-level columns including \code{sample_id}, \code{sample_node_id}, \code{group_id}, and -\code{primary_group}. When available, it also carries \code{batch_group}, -\code{study_group}, \code{timepoint_id}, \code{time_index}, and -\code{order_rank}. Missing but relevant fields are retained as \code{NA} -columns rather than omitted. +\code{primary_group}. When available, it also carries the blocking columns +(\code{batch_group}, \code{study_group}, \code{site_group}, +\code{region_group}, \code{platform_group}, \code{assay_group}), the +\code{stratum} annotation, and the ordering columns (\code{timepoint_id}, +\code{time_index}, \code{order_rank}). Missing but relevant fields are +retained as \code{NA} columns rather than omitted. + +\code{stratum} is filled from the graph when one is supplied: the key of the +single \code{Outcome} node attached to a sample via +\code{sample_has_outcome}, or, failing that, the single outcome attached to +the sample's subject via \code{subject_has_outcome}. It is an +\emph{annotation} of the outcome level each sample carries, exposed through +\code{stratum_var} so a downstream consumer (for example scikit-learn's +\code{StratifiedGroupKFold}) can stratify; splitGraph itself never balances +folds. When no sample has a unique outcome, \code{stratum_var} is +\code{NULL}. When only a subset of samples has ordering metadata, the translated split spec still exposes that partial ordering through \code{time_var}, but \code{ordering_required} remains \code{FALSE}. Ordering is only marked as required when the constraint implies complete ordering coverage. +When \code{graph} is supplied, the blocking and ordering annotation columns +are filled from the graph wherever the constraint left them \code{NA}. This +enrichment is best-effort: a source that cannot be resolved unambiguously +(for example a sample linked to two batches on a graph built with +\code{validate = FALSE}) is left as \code{NA} and the reason is recorded in +\code{metadata$enrichment_warnings} (and appended to +\code{metadata$warnings}) instead of aborting the translation. The primary +\code{group_id} always comes from the constraint and is never affected. + The split-spec validator checks: \itemize{ \item missing required columns @@ -75,6 +96,38 @@ dependency on any of them. \code{split_constraint} metadata rather than duplicating downstream evaluation logic. } +\section{What downstream consumers read}{ + +The \code{split_spec} contract is wider than any single consumer uses today. +Verified against the released versions on 2026-09-14: + +\tabular{lll}{ + \strong{Consumer} \tab \strong{Reads} \tab \strong{Modes} \cr + bioLeak 0.3.8 \code{as_leaksplits()} \tab + \code{sample_data} columns \code{sample_id}, the \code{group_var} column, + \code{batch_group}, \code{study_group}, \code{timepoint_id}, + \code{order_rank}; fields \code{group_var}, \code{constraint_mode}, + \code{time_var} \tab + subject, batch, study, time. Every other \code{constraint_mode} + currently \emph{errors} inside bioLeak: site, region, platform, assay, + relatedness and spatial are absent from its mode map ("subscript out of + bounds"), and composite maps to \code{make_split_plan(mode = + "combined")} without the \code{constraints} / \code{primary_axis} that + mode requires. Until that is fixed, join \code{group_id} onto your + observation frame and call \code{bioLeak::make_split_plan(group = + "group_id")} directly; the grouping is preserved. \cr + Python \code{splitspec} reader (shipped) \tab + every field and column, including \code{stratum_var} / \code{stratum} + and the block columns \tab all \cr + rsample (adapter-cookbook vignette) \tab + \code{group_id} for \code{group_vfold_cv()}, \code{order_rank} for + \code{rolling_origin()}; block columns read for fold auditing \tab all \cr +} +Every row is pinned by a contract test (run when bioLeak is installed), +including the workaround, so the seam cannot drift silently; the test fails +deliberately when a bioLeak release starts accepting the other modes. +} + \examples{ meta <- data.frame( sample_id = c("S1", "S2", "S3", "S4"), diff --git a/man/build_dependency_graph.Rd b/man/build_dependency_graph.Rd index 3bfe7a0..07ed34a 100644 --- a/man/build_dependency_graph.Rd +++ b/man/build_dependency_graph.Rd @@ -2,10 +2,8 @@ % Please edit documentation in R/graph-build.R, R/validate.R \name{build_dependency_graph} \alias{build_dependency_graph} -\alias{build_depgraph} \alias{as_igraph} \alias{validate_graph} -\alias{validate_depgraph} \title{Assemble and Validate Dependency Graphs} \usage{ build_dependency_graph( @@ -17,29 +15,10 @@ build_dependency_graph( validation_overrides = list() ) -build_depgraph( - nodes, - edges, - graph_name = NULL, - dataset_name = NULL, - validate = TRUE, - validation_overrides = list() -) - as_igraph(x) validate_graph( graph, - checks = c("ids", "references", "cardinality", "schema", "time"), - error_on_fail = FALSE, - levels = NULL, - severities = NULL, - validation_overrides = NULL -) - -validate_depgraph( - graph, - checks = c("ids", "references", "cardinality", "schema", "time"), error_on_fail = FALSE, levels = NULL, severities = NULL, @@ -63,17 +42,14 @@ exceptions. Currently supported keys: first listed subject assignment (recording the ambiguity in \code{metadata$warnings}). Defaults to \code{FALSE}.} } -When passed to \code{validate_graph()} or \code{validate_depgraph()}, -the override is merged into the graph's existing -\code{validation_overrides} for the duration of the call only.} +When passed to \code{validate_graph()}, the override is merged into the +graph's existing \code{validation_overrides} for the duration of the call +only.} \item{x}{A \code{dependency_graph}.} \item{graph}{A \code{dependency_graph}.} -\item{checks}{\strong{Deprecated.} Use \code{levels} and \code{severities} -instead. Retained for backward compatibility with 0.1.0 callers.} - \item{error_on_fail}{If \code{TRUE}, stop when validation errors are found across all detected issues from the selected validation levels, even if those errors are hidden from \code{issues} by \code{severities}.} @@ -86,9 +62,8 @@ considered valid.} } \value{ For \code{build_dependency_graph()}, a \code{dependency_graph}. For - \code{validate_graph()} and \code{validate_depgraph()}, a - \code{depgraph_validation_report}. For \code{as_igraph()}, the underlying - \code{igraph} object. + \code{validate_graph()}, a \code{depgraph_validation_report}. For + \code{as_igraph()}, the underlying \code{igraph} object. } \description{ Combine canonical node and edge tables into a typed dependency graph and diff --git a/man/depgraph_validation_report.Rd b/man/depgraph_validation_report.Rd index 4d3d3b0..7dea405 100644 --- a/man/depgraph_validation_report.Rd +++ b/man/depgraph_validation_report.Rd @@ -23,6 +23,7 @@ split_spec( group_var = "group_id", block_vars = character(), time_var = NULL, + stratum_var = NULL, ordering_required = FALSE, constraint_mode = NULL, constraint_strategy = NULL, @@ -65,6 +66,10 @@ severity-specific messages.} \item{time_var}{Optional ordering column name.} +\item{stratum_var}{Optional name of the column carrying the stratum +annotation (the outcome level each sample carries). An annotation only: +splitGraph never balances folds.} + \item{ordering_required}{Whether ordering is required for downstream evaluation.} diff --git a/man/derive_split_constraints.Rd b/man/derive_split_constraints.Rd index 2aa0f65..edd678b 100644 --- a/man/derive_split_constraints.Rd +++ b/man/derive_split_constraints.Rd @@ -32,7 +32,15 @@ modes.} \item{via}{Optional dependency sources used for composite grouping. May be given as lower-case modes such as \code{"subject"} or node types such as -\code{"Subject"}.} +\code{"Subject"}. Any direct-assignment source (\code{"subject"}, +\code{"batch"}, \code{"study"}, \code{"time"}, \code{"site"}, +\code{"region"}, \code{"platform"}, \code{"assay"}) and either pairwise +source (\code{"relatedness"}, \code{"spatial"}) can be combined. In the +strict strategy a pairwise source contributes its thresholded edges to the +same connected-component search as the direct relations; in the +rule-based strategy it contributes the component label, and a singleton +component counts as "no assignment" so the sample falls through to the +next mode. Defaults to \code{c("subject", "batch", "study", "time")}.} \item{priority}{Optional priority order used for \code{strategy = "rule_based"}.} diff --git a/man/export_graph.Rd b/man/export_graph.Rd new file mode 100644 index 0000000..a70ac63 --- /dev/null +++ b/man/export_graph.Rd @@ -0,0 +1,48 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/export.R +\name{export_graph} +\alias{export_graph} +\title{Export a Dependency Graph for Other Tools} +\usage{ +export_graph( + graph, + file, + format = c("graphml", "gml", "nodes_csv", "edges_csv") +) +} +\arguments{ +\item{graph}{A \code{dependency_graph}.} + +\item{file}{Path to write. For the CSV formats this is the single table +requested (\code{nodes_csv} writes the node table, \code{edges_csv} the +edge table).} + +\item{format}{One of \code{"graphml"}, \code{"gml"}, \code{"nodes_csv"}, +\code{"edges_csv"}.} +} +\value{ +The normalised output path, invisibly. +} +\description{ +Write a \code{dependency_graph} as GraphML or GML (readable by Cytoscape, +Gephi, networkx, and \code{igraph::read_graph()}), or as flat CSV tables of +nodes or edges. This complements the lossless JSON format of +\code{\link{write_dependency_graph}}: the JSON round-trips exactly and is +the interchange contract; these exports are for visual inspection and +analysis in graph tools and lose nothing but the nesting of attributes. +} +\details{ +Node attributes (the \code{attrs} list-column) are flattened into scalar +columns named \code{attr_}; multi-valued attributes are collapsed with +\code{";"}. Canonical columns (\code{node_id}, \code{node_type}, +\code{node_key}, \code{label}; \code{edge_id}, \code{edge_type}) are written +as-is. In GraphML/GML the vertex \code{name} is the \code{node_id}. +} +\examples{ +meta <- data.frame(sample_id = c("S1", "S2"), subject_id = c("P1", "P2")) +g <- graph_from_metadata(meta) +tmp <- tempfile(fileext = ".graphml") +export_graph(g, tmp, format = "graphml") +igraph::vcount(igraph::read_graph(tmp, format = "graphml")) +unlink(tmp) +} diff --git a/man/graph_edit.Rd b/man/graph_edit.Rd new file mode 100644 index 0000000..67a8a89 --- /dev/null +++ b/man/graph_edit.Rd @@ -0,0 +1,104 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/graph-edit.R +\name{graph_edit} +\alias{graph_edit} +\alias{subset_graph} +\alias{combine_graphs} +\alias{add_edges} +\title{Edit Dependency Graphs} +\usage{ +subset_graph( + graph, + samples, + graph_name = NULL, + dataset_name = NULL, + validate = TRUE +) + +combine_graphs(..., graph_name = NULL, dataset_name = NULL, validate = TRUE) + +add_edges( + graph, + edges, + graph_name = NULL, + dataset_name = NULL, + validate = TRUE +) +} +\arguments{ +\item{graph}{A \code{dependency_graph}.} + +\item{samples}{Sample identifiers or sample node ids to keep. All must +resolve; unknown ids raise a \code{splitgraph_reference_error}.} + +\item{graph_name, dataset_name}{Optional labels for the result. When +\code{NULL}, \code{subset_graph()} and \code{add_edges()} inherit the +input's labels, and \code{combine_graphs()} uses the first non-\code{NULL} +label among its inputs.} + +\item{validate}{If \code{TRUE} (default), run \code{validate_graph()} on the +result and fail on error-severity issues, as +\code{build_dependency_graph()} does.} + +\item{...}{For \code{combine_graphs()}, two or more \code{dependency_graph}s +(or a single list of them).} + +\item{edges}{A \code{graph_edge_set} or a list of them.} +} +\value{ +A \code{dependency_graph}. +} +\description{ +Derive a new \code{dependency_graph} from existing ones without rebuilding +from node and edge sets: restrict a graph to a subset of samples, take the +union of several graphs, or append edge sets to a graph. Every function +returns a new, independently validated \code{dependency_graph}; the inputs +are never modified. +} +\details{ +\code{subset_graph()} keeps the requested \code{Sample} nodes, every edge +rooted at one of them (a \code{sample_adjacent_to} edge is kept only when +both samples are kept), the non-sample nodes those edges point to, and, +transitively, non-sample nodes reachable from kept nodes through +non-sample edges (\code{assay_uses_platform}, +\code{featureset_generated_from_*}, \code{subject_related_to}, +\code{subject_has_outcome}). \code{timepoint_precedes} edges are kept only +between retained timepoints, so when \code{time_index} is absent the +ordering of a subset may become partial; \code{derive_split_constraints(mode += "time")} reports that in its warnings. Restricting the graph this way has +the same semantics as the \code{samples} argument of +\code{\link{derive_split_constraints}}: structure that only reaches the +subset through excluded samples is dropped. + +\code{combine_graphs()} takes the union of node and edge tables. Identical +rows are collapsed; a node id or an \code{(from, to, edge_type)} relation +defined differently in two graphs is an error of class +\code{splitgraph_ambiguity_error}. Edge ids are regenerated per edge type +(\code{":"}), since ids from different graphs would collide. +Metadata \code{validation_overrides} and \code{edge_sources} are merged with +later graphs taking precedence. + +\code{add_edges()} appends one or more \code{graph_edge_set}s (for example +the output of \code{\link{relatedness_edges_from_kinship}}) to a graph. New +edges receive ids that continue the existing numbering of their edge type; +existing ids are preserved. Endpoints must already exist in the graph. +} +\examples{ +meta <- data.frame( + sample_id = c("S1", "S2", "S3", "S4"), + subject_id = c("P1", "P1", "P2", "P3"), + batch_id = c("B1", "B1", "B2", "B2") +) +g <- graph_from_metadata(meta, graph_name = "full") + +g_sub <- subset_graph(g, samples = c("S1", "S2")) +summary(g_sub)$node_types + +pairs <- data.frame(id1 = "P1", id2 = "P2", kinship = 0.25) +g_kin <- add_edges(g, relatedness_edges_from_kinship(pairs, threshold = 0.1)) +grouping_vector(derive_split_constraints(g_kin, mode = "relatedness")) + +meta2 <- data.frame(sample_id = c("S5", "S6"), subject_id = c("P3", "P4")) +g_all <- combine_graphs(g, graph_from_metadata(meta2)) +summary(g_all)$n_nodes +} diff --git a/man/graph_from_metadata.Rd b/man/graph_from_metadata.Rd index f8aca17..2e033dd 100644 --- a/man/graph_from_metadata.Rd +++ b/man/graph_from_metadata.Rd @@ -2,9 +2,18 @@ % Please edit documentation in R/graph-build-auto.R \name{graph_from_metadata} \alias{graph_from_metadata} +\alias{graph_from_metadata.default} +\alias{graph_from_metadata.SummarizedExperiment} +\alias{graph_from_metadata.data.frame} \title{Build a Dependency Graph Directly from a Metadata Table} \usage{ -graph_from_metadata( +graph_from_metadata(meta, ...) + +\method{graph_from_metadata}{default}(meta, ...) + +\method{graph_from_metadata}{SummarizedExperiment}(meta, ..., sample_id_col = NULL) + +\method{graph_from_metadata}{data.frame}( meta, columns = NULL, dataset_name = NULL, @@ -12,15 +21,25 @@ graph_from_metadata( outcome_scope = c("sample", "subject"), time_precedence = TRUE, validate = TRUE, - validation_overrides = list() + validation_overrides = list(), + ... ) } \arguments{ \item{meta}{A \code{data.frame} containing one row per sample and optional canonical columns: \code{sample_id} (required), \code{subject_id}, \code{batch_id}, \code{study_id}, \code{timepoint_id}, \code{time_index}, -\code{assay_id}, \code{featureset_id}, \code{outcome_id}, or -\code{outcome_value}.} +\code{assay_id}, \code{featureset_id}, \code{site_id}, \code{region_id}, +\code{platform_id}, \code{outcome_id}, or \code{outcome_value}. +Identifier columns may be character, factor, or numeric; they are +coerced to character by \code{ingest_metadata()}.} + +\item{...}{Passed on to the \code{data.frame} method.} + +\item{sample_id_col}{For the \code{SummarizedExperiment} method: the +\code{colData} column holding sample identifiers. When \code{NULL} +(default) a \code{sample_id} column is used if present, otherwise the +assay column names (\code{colnames(se)}) become the sample identifiers.} \item{columns}{Optional named character vector passed to \code{ingest_metadata()} to rename user columns to canonical names.} @@ -48,6 +67,17 @@ derives timepoint ordering from \code{time_index}, and assembles a \code{dependency_graph}. Columns that are absent or entirely missing are silently skipped. } +\details{ +\code{graph_from_metadata()} is an S3 generic. The \code{data.frame} method +is the one described above. The \code{SummarizedExperiment} method (used +when Bioconductor's \pkg{SummarizedExperiment} is installed) converts +\code{colData(se)} to a data frame, adds \code{sample_id} from the assay +column names when \code{colData} has no such column, and dispatches to the +\code{data.frame} method; \code{columns} maps \code{colData} names to the +canonical ones exactly as for a data frame. A worked example is in +\code{vignette("faq-design-notes")}; it is kept out of the examples below +because attaching Bioconductor packages dominates their run time. +} \examples{ meta <- data.frame( sample_id = c("S1", "S2", "S3", "S4"), diff --git a/man/graph_node_set.Rd b/man/graph_node_set.Rd index 4814842..ce574cf 100644 --- a/man/graph_node_set.Rd +++ b/man/graph_node_set.Rd @@ -4,11 +4,7 @@ \alias{graph_node_set} \alias{graph_edge_set} \alias{dependency_graph} -\alias{new_depgraph_nodes} -\alias{new_depgraph_edges} -\alias{new_depgraph} \alias{graph_query_result} -\alias{dependency_constraint} \alias{split_constraint} \title{Construct Core splitGraph S3 Objects} \usage{ @@ -26,20 +22,6 @@ graph_edge_set( dependency_graph(nodes, edges, graph, metadata = list(), caches = list()) -new_depgraph_nodes( - data = NULL, - schema_version = .depgraph_schema_version, - source = list() -) - -new_depgraph_edges( - data = NULL, - schema_version = .depgraph_schema_version, - source = list() -) - -new_depgraph(nodes, edges, graph = NULL, metadata = list(), caches = list()) - graph_query_result( query = "", params = list(), @@ -49,14 +31,6 @@ graph_query_result( metadata = list() ) -dependency_constraint( - constraint_id, - relation_types, - sample_map, - transitive = TRUE, - metadata = list() -) - split_constraint( strategy, sample_map, @@ -82,12 +56,9 @@ auxiliary metadata.} \item{table}{Tabular query result payload.} -\item{constraint_id, relation_types, transitive}{Fields describing a -dependency constraint.} +\item{strategy}{Split strategy identifier.} \item{sample_map}{Sample-level mapping table for constraints.} - -\item{strategy}{Split strategy identifier.} } \value{ An S3 object corresponding to the constructor that was called. diff --git a/man/pairwise_edges.Rd b/man/pairwise_edges.Rd index 125ad7e..7151427 100644 --- a/man/pairwise_edges.Rd +++ b/man/pairwise_edges.Rd @@ -17,8 +17,11 @@ relatedness_edges_from_kinship( spatial_edges_from_coords(coords, radius, id = "sample_id", coord_cols = NULL) } \arguments{ -\item{pairs}{A data.frame of subject pairs with two id columns and a metric -column.} +\item{pairs}{Either a data.frame of subject pairs with two id columns and a +metric column (the long format written by KING, GCTA, and most kinship +tools), or a square symmetric numeric matrix whose row names are subject +ids (e.g. PLINK \code{--make-rel square} output); a matrix is expanded to +its upper-triangle pairs before thresholding.} \item{threshold}{Minimum kinship value (inclusive) for a pair to be kept.} diff --git a/man/plot.dependency_graph.Rd b/man/plot.dependency_graph.Rd new file mode 100644 index 0000000..d6b394f --- /dev/null +++ b/man/plot.dependency_graph.Rd @@ -0,0 +1,70 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/methods.R +\name{plot.dependency_graph} +\alias{plot.dependency_graph} +\title{Plot a Dependency Graph} +\usage{ +\method{plot}{dependency_graph}( + x, + layout = c("typed", "sugiyama", "auto"), + focus = c("full", "sample_projection", "ego"), + node = NULL, + via = NULL, + order = 1L, + node_colors = NULL, + show_labels = TRUE, + legend = TRUE, + legend_position = "topleft", + ... +) +} +\arguments{ +\item{x}{A \code{dependency_graph}.} + +\item{layout}{\code{"typed"} (one row per node-type layer), +\code{"sugiyama"} (igraph's layered layout), \code{"auto"} (igraph's +default), a layout matrix, or a function of the igraph object returning +one. For \code{focus = "sample_projection"} the typed layout is replaced by +a force-directed one, since every node is a sample.} + +\item{focus}{What to draw. \code{"full"} (default) draws the typed graph. +\code{"sample_projection"} draws only the \code{Sample} nodes, joined when +they share a dependency target of a type in \code{via}: the picture of the +grouping that \code{derive_split_constraints(mode = "composite")} would +produce. \code{"ego"} draws the neighbourhood of \code{node} up to +\code{order} steps in either direction.} + +\item{node}{For \code{focus = "ego"}: the node id (e.g. \code{"sample:S1"}) +at the centre of the neighbourhood.} + +\item{via}{For \code{focus = "sample_projection"}: dependency node types +that link samples. Defaults to Subject, Batch, Study, Timepoint.} + +\item{order}{For \code{focus = "ego"}: neighbourhood radius in edges.} + +\item{node_colors}{Optional named vector overriding the type palette.} + +\item{show_labels}{Draw node labels.} + +\item{legend, legend_position}{Draw a node-type legend and where.} + +\item{...}{Further arguments passed to \code{igraph}'s plot method.} +} +\value{ +\code{x}, invisibly. Called for the plot. +} +\description{ +Draw a \code{dependency_graph} with node colours by type and, by default, a +layered layout that places samples on the bottom row and their dependency +targets above them. +} +\examples{ +meta <- data.frame( + sample_id = c("S1", "S2", "S3"), subject_id = c("P1", "P1", "P2"), + batch_id = c("B1", "B2", "B1") +) +g <- graph_from_metadata(meta) +plot(g) +plot(g, focus = "sample_projection", via = "Subject") +plot(g, focus = "ego", node = "subject:P1") +} diff --git a/man/splitgraph_conditions.Rd b/man/splitgraph_conditions.Rd new file mode 100644 index 0000000..bd4de99 --- /dev/null +++ b/man/splitgraph_conditions.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/splitGraph-package.R +\name{splitgraph_conditions} +\alias{splitgraph_conditions} +\title{Classed Conditions Signalled by splitGraph} +\description{ +Every error raised by \pkg{splitGraph} is a classed condition that inherits +from \code{"splitgraph_error"} (and \code{"error"}), so callers can handle +the package's failures selectively with \code{tryCatch()} without matching +on message text. Each condition also carries a machine-readable \code{code} +field drawn from the same vocabulary as the \code{code} column of a +\code{depgraph_validation_report} where one applies (for example +\code{"missing_source_node"} or \code{"sample_multiple_batch_assignments"}), +and \code{NA} otherwise. +} +\section{Condition classes}{ + +\describe{ + \item{\code{splitgraph_error}}{Base class of every splitGraph error, + including argument checks that do not fall in a category below.} + \item{\code{splitgraph_schema_error}}{The input violates the typed schema: + an unsupported node or edge type, an edge whose endpoints have the wrong + node types, a graph with no \code{Sample} node, or a JSON document that + is not the expected splitGraph object.} + \item{\code{splitgraph_reference_error}}{An identifier does not resolve or + is not unique: edge endpoints missing from the node table, duplicated + node or edge ids, unknown node or sample ids passed to a query, or a + missing edge endpoint value.} + \item{\code{splitgraph_ambiguity_error}}{The structure admits more than + one answer where exactly one is required: conflicting definitions for + the same node or edge, or a sample linked to several targets of a + single-valued relation when deriving a direct constraint.} + \item{\code{splitgraph_validation_error}}{\code{validate_graph(error_on_fail + = TRUE)} or \code{build_dependency_graph(validate = TRUE)} found + error-severity issues, or timepoint ordering metadata are inconsistent.} + \item{\code{splitgraph_io_error}}{A file could not be written or parsed.} +} +Warnings raised by the package carry the class \code{"splitgraph_warning"}. +} + +\examples{ +meta <- data.frame(sample_id = c("S1", "S2"), subject_id = c("P1", "P2")) +g <- graph_from_metadata(meta) +res <- tryCatch( + query_neighbors(g, "sample:does-not-exist"), + splitgraph_reference_error = function(e) e$code +) +res +} diff --git a/man/validate_json.Rd b/man/validate_json.Rd index 94612cb..d1af9a3 100644 --- a/man/validate_json.Rd +++ b/man/validate_json.Rd @@ -22,7 +22,8 @@ A \code{splitgraph_json_report}: a list with \code{valid} (logical), \description{ Check that a JSON file written by \code{write_dependency_graph()} or \code{write_split_spec()} conforms to the splitGraph on-disk contract. The -formal JSON Schemas (Draft 2020-12) ship in \code{inst/schema/} and are +formal JSON Schemas (Draft 2020-12) ship in +\code{inst/schema//} and are referenced from the written JSON via the \code{$schema} key; these functions apply a dependency-free structural check of the same invariants (required fields, value types, node/edge-type enumerations, and referential integrity diff --git a/man/write_dependency_graph.Rd b/man/write_dependency_graph.Rd index a61bf7e..4ce4c09 100644 --- a/man/write_dependency_graph.Rd +++ b/man/write_dependency_graph.Rd @@ -7,7 +7,7 @@ \usage{ write_dependency_graph(graph, path, pretty = TRUE) -read_dependency_graph(path) +read_dependency_graph(path, validate = FALSE) } \arguments{ \item{graph}{A \code{dependency_graph} produced by @@ -17,11 +17,22 @@ read_dependency_graph(path) \item{pretty}{If \code{TRUE} (default), the JSON is indented for human inspection. Set \code{FALSE} for a compact representation.} + +\item{validate}{If \code{TRUE}, check the file against the shipped schema +(\code{validate_graph_json()} / \code{validate_split_spec_json()}) before +parsing and run \code{validate_graph()} (for graphs) or +\code{validate_split_spec()} (for specs) on the result, failing with a +classed error on any violation or error-severity issue. The default +\code{FALSE} loads the object as written, so a graph saved with +\code{validate = FALSE} or predating a validation rule still loads; use +\code{validate = TRUE} for files from untrusted or older sources.} } \value{ \code{write_dependency_graph()} invisibly returns \code{path}. - \code{read_dependency_graph()} returns a validated - \code{dependency_graph}. + \code{read_dependency_graph()} returns a \code{dependency_graph} whose + node and edge tables are checked for internal consistency with the + rebuilt \code{igraph}; with the default \code{validate = FALSE} it is + \emph{not} re-run through \code{validate_graph()}. } \description{ Write a \code{dependency_graph} to a JSON file and read it back. The on-disk @@ -41,15 +52,20 @@ read JSON can interpret the format). \preformatted{ { - "$schema": "https://.../inst/schema/dependency_graph.schema.json", + "$schema": "https://.../inst/schema/0.3.0/dependency_graph.schema.json", "splitGraph_object": "dependency_graph", - "schema_version": "0.2.0", + "schema_version": "0.3.0", "metadata": { "graph_name": "...", "dataset_name": "...", "created_at": "2026-04-29T10:11:12.000000+0000", - "schema_version": "0.2.0", - "validation_overrides": { ... } + "schema_version": "0.3.0", + "validation_overrides": { ... }, + "edge_sources": { + "subject_related_to": { "relation": "...", "from_col": "...", + "to_col": "...", "threshold": 0.125, + "metric": "kinship" } + } }, "nodes": [ { "node_id": "sample:S1", "node_type": "Sample", @@ -68,8 +84,9 @@ Reading a file whose \code{schema_version} shares the installed major version loads silently (additive-only differences); a differing major version loads with a warning suggesting \code{migrate_dependency_graph_json()}. The written JSON also carries a \code{$schema} reference to the formal JSON -Schema shipped in \code{inst/schema/}; validate a file against it with -\code{validate_graph_json()}. +Schema shipped under \code{inst/schema//}; validate a file +against it with \code{validate_graph_json()} or by passing +\code{validate = TRUE} when reading. } \examples{ diff --git a/man/write_split_spec.Rd b/man/write_split_spec.Rd index 474e35d..aec8032 100644 --- a/man/write_split_spec.Rd +++ b/man/write_split_spec.Rd @@ -7,7 +7,7 @@ \usage{ write_split_spec(spec, path, pretty = TRUE) -read_split_spec(path) +read_split_spec(path, validate = FALSE) } \arguments{ \item{spec}{A \code{split_spec} produced by \code{as_split_spec()}.} @@ -15,6 +15,11 @@ read_split_spec(path) \item{path}{Path to write to or read from.} \item{pretty}{If \code{TRUE} (default), the JSON is indented.} + +\item{validate}{If \code{TRUE}, check the file against the shipped schema +before parsing and run \code{validate_split_spec()} on the result, failing +with a classed error on any violation or error-severity issue. Defaults to +\code{FALSE}.} } \value{ \code{write_split_spec()} invisibly returns \code{path}. @@ -37,23 +42,29 @@ read back as \code{NA}. \preformatted{ { - "$schema": "https://.../inst/schema/split_spec.schema.json", + "$schema": "https://.../inst/schema/0.3.0/split_spec.schema.json", "splitGraph_object": "split_spec", - "schema_version": "0.2.0", + "schema_version": "0.3.0", "group_var": "group_id", "block_vars": ["batch_group", "study_group"], "time_var": "order_rank", + "stratum_var": "stratum", "ordering_required": false, "constraint_mode": "subject", "constraint_strategy": "subject", "recommended_resampling": "grouped_cv", - "metadata": { ... }, + "metadata": { "relations_used": [...], "via": [...], "priority": [...], + "threshold": null, "warnings": [...], ... }, "sample_data": [ - { "sample_id": "S1", "group_id": "subject:P1", ... }, + { "sample_id": "S1", "group_id": "subject:P1", "stratum": "case", ... }, ... ] } } +Vector-valued metadata fields are always written as arrays, even with a +single element. \code{stratum_var} and the \code{stratum} column were added +in schema 0.3.0; files written by earlier versions load with \code{stratum} +filled as \code{NA}. } \examples{ diff --git a/paper-figures/paper-pipeline.png b/paper-figures/paper-pipeline.png new file mode 100644 index 0000000..fc802e6 Binary files /dev/null and b/paper-figures/paper-pipeline.png differ diff --git a/paper.bib b/paper.bib index 3d45759..6872066 100644 --- a/paper.bib +++ b/paper.bib @@ -1,40 +1,131 @@ @article{kaufman2012leakage, - title={Leakage in data mining: Formulation, detection, and avoidance}, - author={Kaufman, Shachar and Rosset, Saharon and Perlich, Claudia and Stitelman, Ori}, - journal={ACM Transactions on Knowledge Discovery from Data}, - volume={6}, - number={4}, - pages={1--21}, - year={2012}, - publisher={ACM}, - doi={10.1145/2382577.2382579} + title = {Leakage in data mining: Formulation, detection, and avoidance}, + author = {Kaufman, Shachar and Rosset, Saharon and Perlich, Claudia and Stitelman, Ori}, + journal = {ACM Transactions on Knowledge Discovery from Data}, + volume = {6}, + number = {4}, + pages = {1--21}, + year = {2012}, + publisher = {Association for Computing Machinery}, + doi = {10.1145/2382577.2382579} +} + +@article{kapoor2023leakage, + title = {Leakage and the reproducibility crisis in machine-learning-based science}, + author = {Kapoor, Sayash and Narayanan, Arvind}, + journal = {Patterns}, + volume = {4}, + number = {9}, + pages = {100804}, + year = {2023}, + publisher = {Elsevier}, + doi = {10.1016/j.patter.2023.100804} +} + +@article{whalen2022pitfalls, + title = {Navigating the pitfalls of applying machine learning in genomics}, + author = {Whalen, Sean and Schreiber, Jacob and Noble, William S. and Pollard, Katherine S.}, + journal = {Nature Reviews Genetics}, + volume = {23}, + number = {3}, + pages = {169--181}, + year = {2022}, + publisher = {Springer Nature}, + doi = {10.1038/s41576-021-00434-9} } @article{roberts2017crossvalidation, - title={Cross-validation strategies for data with temporal, spatial, hierarchical, or phylogenetic structure}, - author={Roberts, David R. and Bahn, Volker and Ciuti, Simone and Boyce, Mark S. and Elith, Jane and Guillera-Arroita, Gurutzeta and Hauenstein, Severin and Lahoz-Monfort, Jos{\'e} J. and Schr{\"o}der, Boris and Thuiller, Wilfried and others}, - journal={Ecography}, - volume={40}, - number={8}, - pages={913--929}, - year={2017}, - publisher={Wiley}, - doi={10.1111/ecog.02881} + title = {Cross-validation strategies for data with temporal, spatial, hierarchical, or phylogenetic structure}, + author = {Roberts, David R. and Bahn, Volker and Ciuti, Simone and Boyce, Mark S. and Elith, Jane and Guillera-Arroita, Gurutzeta and Hauenstein, Severin and Lahoz-Monfort, Jos{\'e} J. and Schr{\"o}der, Boris and Thuiller, Wilfried and Warton, David I. and Wintle, Brendan A. and Hartig, Florian and Dormann, Carsten F.}, + journal = {Ecography}, + volume = {40}, + number = {8}, + pages = {913--929}, + year = {2017}, + publisher = {Wiley}, + doi = {10.1111/ecog.02881} } @article{pedregosa2011scikit, - title={Scikit-learn: Machine learning in Python}, - author={Pedregosa, Fabian and Varoquaux, Ga{\"e}l and Gramfort, Alexandre and Michel, Vincent and Thirion, Bertrand and Grisel, Olivier and Blondel, Mathieu and Prettenhofer, Peter and Weiss, Ron and Dubourg, Vincent and others}, - journal={Journal of Machine Learning Research}, - volume={12}, - pages={2825--2830}, - year={2011} + title = {Scikit-learn: Machine learning in {Python}}, + author = {Pedregosa, Fabian and Varoquaux, Ga{\"e}l and Gramfort, Alexandre and Michel, Vincent and Thirion, Bertrand and Grisel, Olivier and Blondel, Mathieu and Prettenhofer, Peter and Weiss, Ron and Dubourg, Vincent and Vanderplas, Jake and Passos, Alexandre and Cournapeau, David and Brucher, Matthieu and Perrot, Matthieu and Duchesnay, {\'E}douard}, + journal = {Journal of Machine Learning Research}, + volume = {12}, + pages = {2825--2830}, + year = {2011} } @Manual{rsample, - title={rsample: General Resampling Infrastructure}, - author={Frick, Hannah and Chow, Fanny and Kuhn, Max and Mahoney, Michael and Silge, Julia and Wickham, Hadley}, - year={2024}, - note={R package version 1.2.1}, - url={https://rsample.tidymodels.org} + title = {rsample: General Resampling Infrastructure}, + author = {Hannah Frick and Fanny Chow and Max Kuhn and Michael Mahoney and Julia Silge and Hadley Wickham}, + year = {2025}, + note = {R package version 1.3.1}, + url = {https://CRAN.R-project.org/package=rsample}, + doi = {10.32614/CRAN.package.rsample} +} + +@article{schratz2024mlr3spatiotempcv, + title = {{mlr3spatiotempcv}: Spatiotemporal resampling methods for machine learning in {R}}, + author = {Schratz, Patrick and Becker, Marc and Lang, Michel and Brenning, Alexander}, + journal = {Journal of Statistical Software}, + volume = {111}, + number = {7}, + pages = {1--36}, + year = {2024}, + doi = {10.18637/jss.v111.i07} +} + +@article{valavi2019blockcv, + title = {{blockCV}: An {R} package for generating spatially or environmentally separated folds for k-fold cross-validation of species distribution models}, + author = {Valavi, Roozbeh and Elith, Jane and Lahoz-Monfort, Jos{\'e} J. and Guillera-Arroita, Gurutzeta}, + journal = {Methods in Ecology and Evolution}, + volume = {10}, + number = {2}, + pages = {225--232}, + year = {2019}, + publisher = {Wiley}, + doi = {10.1111/2041-210X.13107} +} + +@article{meyer2018cast, + title = {Improving performance of spatio-temporal machine learning models using forward feature selection and target-oriented validation}, + author = {Meyer, Hanna and Reudenbach, Christoph and Hengl, Tomislav and Katurji, Marwan and Nauss, Thomas}, + journal = {Environmental Modelling \& Software}, + volume = {101}, + pages = {1--9}, + year = {2018}, + publisher = {Elsevier}, + doi = {10.1016/j.envsoft.2017.12.001} +} + +@article{csardi2006igraph, + title = {The igraph software package for complex network research}, + author = {Cs{\'a}rdi, G{\'a}bor and Nepusz, Tam{\'a}s}, + journal = {InterJournal}, + volume = {Complex Systems}, + pages = {1695}, + year = {2006}, + url = {https://igraph.org} +} + +@article{linsley2014gse60424, + title = {Copy number loss of the interferon gene cluster in melanomas is linked to reduced {T} cell infiltrate and poor patient prognosis}, + author = {Linsley, Peter S. and Speake, Cate and Whalen, Elizabeth and Chaussabel, Damien}, + journal = {PLOS ONE}, + volume = {9}, + number = {10}, + pages = {e109760}, + year = {2014}, + publisher = {Public Library of Science}, + note = {Data deposited in the Gene Expression Omnibus under accession GSE60424}, + doi = {10.1371/journal.pone.0109760} +} + +@Manual{splitgraph, + title = {{splitGraph}: Dataset Dependency Graphs for Leakage-Aware Evaluation}, + author = {Selcuk Korkmaz}, + year = {2026}, + note = {R package version 0.4.0}, + url = {https://CRAN.R-project.org/package=splitGraph}, + doi = {10.32614/CRAN.package.splitGraph} } diff --git a/paper.md b/paper.md index 9b9f131..cc4d2fd 100644 --- a/paper.md +++ b/paper.md @@ -1,5 +1,5 @@ --- -title: 'splitGraph: A validatable, cross-language representation of dataset dependency structure for leakage-aware evaluation' +title: 'splitGraph: A validatable, portable representation of dataset dependency structure for leakage-aware evaluation' tags: - R - machine learning @@ -10,73 +10,248 @@ tags: authors: - name: Selcuk Korkmaz orcid: 0000-0003-4632-6850 + corresponding: true affiliation: 1 affiliations: - name: Department of Biostatistics, Trakya University, Edirne, Turkey index: 1 -date: 2 July 2026 + ror: 00xa0xn82 +date: 17 September 2026 bibliography: paper.bib --- # Summary -Machine-learning evaluations on biomedical data are frequently optimistic -because the resampling scheme ignores the dependency structure of the data: -repeated measurements of the same subject, samples processed in the same batch, -observations from the same study, site, or platform, or genetically related -individuals are split across training and test folds, leaking information and -inflating performance [@kaufman2012leakage; @roberts2017crossvalidation]. -Avoiding this requires knowing, explicitly, which samples are *not* independent. -That knowledge usually lives implicitly in metadata columns and tribal -knowledge, not in an inspectable, checkable artifact. - -`splitGraph` is an R package that makes dataset dependency structure a -first-class, typed object. It represents samples and their provenance -(subjects, batches, studies, timepoints, assays, platforms, sites, anatomical -regions, and pairwise relations such as genetic relatedness and spatial -proximity) as a typed dependency graph; validates that structure; derives -deterministic split **constraints** from it; and emits a stable, tool-agnostic -split specification (`split_spec`). The `split_spec` is a documented interchange -format with a formal JSON Schema and a reference Python consumer, so the same -leakage-aware partition can be reproduced across R, JSON, and Python -(scikit-learn) without re-deriving it. +A predictive model is only as trustworthy as the split used to evaluate it. When +the same subject, batch, study, or sequencing run contributes rows to both the +training and the test set, the test set is no longer independent, and reported +accuracy is optimistic. Leakage of this kind has been formalised for two +decades [@kaufman2012leakage], yet it remains pervasive: a survey across +seventeen scientific fields found it affecting 294 papers, in some cases +reversing their conclusions [@kapoor2023leakage]. Avoiding it requires stating, +explicitly and before any model is fitted, which samples are *not* independent +of one another. + +`splitGraph` makes that statement a first-class object. It reads an ordinary +sample-level metadata table and builds a **typed dependency graph** in which +samples, subjects, batches, studies, timepoints, assays, feature sets, sites, +anatomical regions and platforms are distinct node types connected by named +relations. It then validates that structure, derives a deterministic split +**constraint** from it, and writes a tool-agnostic **split specification** +(`split_spec`) describing which samples must travel together, which coarser axes +should be blocked, in what order samples may be evaluated, and what outcome +level each carries. The specification is a versioned JSON document with a formal +schema, so the same leakage-aware partition can be reproduced in R, in Python, +or in any other language without being re-derived — and without the reasoning +behind it being lost. + +Crucially, `splitGraph` never creates folds. It decides *what must not be +split*; executing that decision is left to resampling engines. # Statement of need -Existing tooling addresses adjacent but distinct problems. Resampling libraries -such as `rsample` [@rsample] and scikit-learn's `model_selection` -[@pedregosa2011scikit] can *execute* grouped, stratified, or time-series splits -once the user supplies a grouping vector, but they do not model where that -grouping comes from, validate it, or make it portable. The representation gap — -turning heterogeneous, often inconsistent metadata into a single validated, -shareable description of "what must not be split" — is unaddressed. - -`splitGraph` targets exactly this representation-and-interchange layer, and -draws a deliberate boundary: it derives constraints and emits `split_spec`, but -never generates folds, fits models, applies purge/embargo, or produces -statistical leakage evidence. Those downstream concerns are owned by consumer -tools. The reference consumer is `bioLeak`, which turns a `split_spec` into an -executable, leakage-audited split plan and provides statistical leakage -diagnostics; a `bioLeak` methods paper is under separate review at the *Journal -of Statistical Software*. Because `split_spec` is neutral, other consumers — an -`rsample` adapter, or the Python reader shipped with `splitGraph` that drives -`GroupKFold`, `StratifiedGroupKFold`, and `TimeSeriesSplit` — can use it -equally. A conformance test asserts that the Python reader recovers exactly the -grouping and ordering that R emitted, and a contract test pins the seam to -`bioLeak`. - -The novel contributions relative to column-based grouping are: (1) a typed, -extensible schema of leakage relations, including *pairwise, thresholded* -relations (relatedness, spatial proximity) whose groups are formed by transitive -closure over a similarity graph — a grouping that a single categorical column -cannot express; (2) structural, semantic, and leakage-relevant validation of the -dependency structure before any split is derived; and (3) a versioned, -schema-checked, cross-language interchange format that decouples *deciding* a -leakage-aware partition from *executing* it. +Researchers fitting models to biomedical, ecological, or otherwise structured +data are routinely told to "group by subject" or "block by batch" +[@roberts2017crossvalidation; @whalen2022pitfalls]. The advice is sound, but the +knowledge it depends on — which of thirty metadata columns encode dependence, +whether a subject appears in two studies, whether a feature set was fitted on +the whole cohort — usually lives in a spreadsheet and a collaborator's memory. +It is transcribed into a grouping vector by hand, once. + +Three consequences follow. The grouping cannot be *validated*: nothing detects +that a sample was assigned to two subjects, or that a declared time ordering +contradicts the recorded timepoint sequence. It cannot be *transported*: a +collaborator in Python re-derives it from the same messy metadata and may not +reproduce it. And it cannot be *audited*: a reviewer sees the folds, not the +reasoning. + +`splitGraph` addresses this representation-and-interchange layer. It is aimed at +analysts who need a leakage-aware split to be inspectable rather than merely +computed, and at package authors who want to consume a dependency-aware +partition without reimplementing its derivation. + +# State of the field + +Resampling infrastructure is mature. `rsample` [@rsample] in R and +scikit-learn's `model_selection` module [@pedregosa2011scikit] in Python execute +grouped, stratified and time-ordered splits competently, but each begins where +`splitGraph` ends: the user supplies a grouping vector, and its provenance, +correctness and portability are outside the library's concern. + +A second family goes further for one class of dependence. `mlr3spatiotempcv` +[@schratz2024mlr3spatiotempcv] collects spatiotemporal resampling methods behind +a common interface; `blockCV` [@valavi2019blockcv] generates spatially and +environmentally separated folds; `CAST` [@meyer2018cast] adds target-oriented +validation for spatio-temporal models. These are sophisticated and, within their +domain, more capable than anything `splitGraph` offers — they model +autocorrelation as a continuous field, which `splitGraph` does not attempt. + +The distinction is one of layer rather than quality. Those packages produce +*resamplings*, tied to one dependence family and one modelling framework, not a +validated serialisable description of the dependency structure itself, readable +outside the host framework. That is the gap: a researcher whose cohort has +repeated subjects *and* shared batches *and* genetically related donors has no +single object that states all of it, checks it for contradictions, and travels +to a collaborator's scikit-learn pipeline unchanged. + +Contributing this upstream to an existing package was considered and rejected. +The contribution is framework-agnostic by construction; placing it inside +`mlr3`, `tidymodels` or scikit-learn would tie a portable artifact to one +ecosystem and defeat the property that motivates it. `splitGraph` is therefore +built to be *consumed* by those packages rather than to compete with them, and +ships adapters demonstrating exactly that. + +# Software design + +\autoref{fig:pipeline} shows the resulting data flow. Three design decisions +carry most of the weight. + +![Data flow through splitGraph. A metadata table becomes a typed dependency +graph, which is validated and reduced to a split constraint, a split +specification and a schema-versioned JSON artifact. Everything right of the +dashed line belongs to a consumer.\label{fig:pipeline}](paper-figures/paper-pipeline.png) + +**Typing the graph rather than generalising it.** Nodes and edges are drawn from +a closed schema of 11 node types and 17 relations, not from arbitrary strings. +This buys validation: because the schema knows that a sample has at most one +subject and that `timepoint_precedes` is acyclic, checks can run automatically +over any graph before a split is derived. An open schema would have been more +flexible and would have made those guarantees impossible. + +**Separating the decision from its execution.** The `split_spec` is the +deliverable, and it is deliberately inert: a sample table plus scalar +declarations of which column plays which role. A consumer keys on the declared +roles rather than hard-coded column names, so the same file drives tools that +have never heard of each other. The format carries a JSON Schema and a +major-version compatibility policy; a reader accepts any file sharing its major +version, so a minor addition — the outcome-level annotation added in schema +0.3.0, say — leaves older files readable and older readers working. + +**Choosing algorithms that survive real cohort sizes.** Dependency grouping is +computed as connected components over a bipartite sample–target graph rather +than by enumerating sample pairs, which keeps the pipeline linear in samples and +edges. On a synthetic cohort of 20,000 samples with repeated subjects, 400 +batches, five studies, eight sites and four timepoints, building the graph, +validating it, deriving a composite constraint and writing the specification +take about six seconds in total on a laptop. The package depends only on +`igraph` [@csardi2006igraph] and base R, so it installs anywhere its consumers +do. + +# Core functionality + +**Validation** runs in three layers. *Structural* checks reject a malformed +graph (dangling edges, duplicate identifiers, an unsupported relation); +*semantic* checks reject a contradictory one (a sample assigned to two subjects, +a time index that disagrees with the recorded precedence); *leakage* checks are +advisory and describe rather than prescribe — repeated subjects, a subject +spanning several studies or sites, a feature set fitted on the whole cohort. + +**Derivation** offers eleven constraint modes. Eight are *direct*: each sample +carries one grouping node (subject, batch, study, time, site, region, platform, +assay). Two are *pairwise and thresholded* — genetic relatedness and spatial +proximity — where groups form by transitive closure over a similarity graph, a +partition no categorical column can express. The eleventh, *composite*, combines +any of the others, strictly or by priority order. + +**Handoff** attaches what the constraint did not use as the primary grouping: +coarser axes as blocking annotations, an ordering rank when the graph carries +time, and each sample's outcome level as a stratum annotation that `splitGraph` +records but never acts on. + +# Example workflow + +Given a data frame `meta` with one row per sample, the whole pipeline is five +calls: + +```r +library(splitGraph) + +g <- graph_from_metadata(meta) +validate_graph(g) + +constraint <- derive_split_constraints(g, mode = "subject") +spec <- as_split_spec(constraint, graph = g) +write_split_spec(spec, "split_spec.json") +``` + +`grouping_vector(constraint)` returns the group per sample for any R resampler. +The JSON file is what crosses the language boundary, with `X` the design +matrix: + +```python +from splitspec import load_split_spec +from sklearn.model_selection import StratifiedGroupKFold + +spec = load_split_spec("split_spec.json") +StratifiedGroupKFold(n_splits=5).split(X, y=spec.strata(), groups=spec.groups()) +``` + +Nothing about the partition is recomputed in Python; it is read. + +# Research impact statement + +`splitGraph` has been available on CRAN since July 2026 [@splitgraph] and is +accompanied by seven vignettes and a suite of 892 test expectations, run on +every change across five continuous-integration configurations spanning macOS, +Windows and Linux, and separately measured at 91.4% statement coverage. + +Its near-term significance rests on being consumed rather than merely published, +and two integrations exist and are pinned by tests. `bioLeak` — an R package for +leakage-audited evaluation, described in a manuscript under separate review — +reads a `split_spec` and turns it into an executable split plan; a contract test +asserts, against the installed `bioLeak`, exactly which fields and modes that +seam supports. The shipped Python consumer is covered by a conformance test +asserting that it recovers precisely the grouping, ordering and stratum +annotation R emitted, so the two implementations cannot drift apart between +releases. + +The design has been exercised on real data: a worked case study takes the +134-sample, 20-donor, seven-cell-population cohort of GEO series GSE60424 +[@linsley2014gse60424] from raw metadata to a handed-off specification, and +shows that a naive five-fold assignment would place all twenty donors on both +sides of a split. + +# AI usage disclosure + +**Tools.** Anthropic Claude (Claude Opus 5, and earlier Claude models during +2026), used through the Claude Code command-line interface. + +**Where used.** Package source code, the test suite, the reference +documentation and vignettes, and the text of this manuscript. + +**Nature and scope of assistance.** Refactoring the derivation routines to +linear-time algorithms; extending the node and edge type schema; scaffolding +and drafting test cases; drafting and revising documentation, vignettes and +this paper; and copy-editing throughout. Assistance was iterative rather than +wholesale: the model proposed implementations and prose, which were then +accepted, altered or rejected. + +**Confirmation of review.** The author reviewed, edited and validated all +AI-assisted output, and made the core design decisions himself — the scope +boundary (deriving constraints but never generating folds), the typed closed +schema, the decision to make `split_spec` a versioned interchange artifact +rather than an in-memory object, and the choice to keep the package free of +resampling dependencies. The author takes full responsibility for the accuracy, +originality and licensing of the software and the paper. + +**Independent verification.** Correctness was checked by mechanisms independent +of the drafting process: 892 test expectations and `R CMD check --as-cran`; a +conformance test comparing the R and Python implementations on the same +artifact; a contract test against the installed downstream consumer; and, before +release, an equivalence check against the previous CRAN version on regression +cohorts. Every empirical claim in this paper was measured, not estimated. + +# Conflicts of interest and funding + +The author develops and maintains `bioLeak`, the R package described above as +the reference consumer of `split_spec`; the two projects are related by design +and are cited here as such. The author declares no financial conflicts of +interest. + +The work received no external financial support. # Acknowledgements -We thank users of the `bioLeak` project for feedback that shaped the -`split_spec` contract. +We thank users of `bioLeak` for feedback that shaped the `split_spec` contract. # References diff --git a/tests/testthat/test-bioleak-contract.R b/tests/testthat/test-bioleak-contract.R index 77606f5..25f509d 100644 --- a/tests/testthat/test-bioleak-contract.R +++ b/tests/testthat/test-bioleak-contract.R @@ -70,3 +70,100 @@ test_that("newer additive columns do not break the bioLeak seam", { ls <- bioLeak::as_leaksplits(spec, data = contract_data(), outcome = "y", v = 3) expect_s4_class(ls, "LeakSplits") }) + +richer_contract_graph <- function() { + meta <- data.frame( + sample_id = paste0("S", 1:12), + subject_id = rep(paste0("P", 1:6), each = 2), + study_id = rep(c("ST1", "ST2"), each = 6), + batch_id = rep(c("B1", "B2", "B3"), times = 4), + site_id = rep(c("NYC", "BOS", "SFO"), times = 4), + region_id = rep(c("cortex", "liver"), times = 6), + platform_id = rep(c("HiSeq", "NovaSeq"), each = 6), + assay_id = rep(c("rna", "atac", "rna"), times = 4), + timepoint_id = rep(c("T1", "T2"), 6), + time_index = rep(c(1, 2), 6), + stringsAsFactors = FALSE + ) + pairs <- data.frame(id1 = c("P1", "P3"), id2 = c("P2", "P4"), kinship = c(0.25, 0.5), stringsAsFactors = FALSE) + coords <- data.frame( + sample_id = meta$sample_id, + x = c(0, 0.1, 5, 5.1, 10, 10.1, 15, 15.1, 20, 20.1, 25, 25.1), y = 0 + ) + g <- graph_from_metadata(meta) + add_edges(g, list( + relatedness_edges_from_kinship(pairs, threshold = 0.1), + spatial_edges_from_coords(coords, radius = 0.5) + )) +} + +test_that("bioLeak 0.3.x accepts exactly the subject / batch / study / time modes", { + skip_if_no_bioleak() + g <- richer_contract_graph() + for (mode in c("subject", "batch", "study", "time")) { + spec <- as_split_spec(derive_split_constraints(g, mode = mode), graph = g) + expect_identical(spec$constraint_mode, mode) + expect_s4_class( + bioLeak::as_leaksplits(spec, data = contract_data(), outcome = "y", v = 2), + "LeakSplits" + ) + } +}) + +test_that("bioLeak 0.3.x rejects the six 0.3.0-era modes AND composite (pinned)", { + skip_if_no_bioleak() + # Two distinct limitations in bioLeak <= 0.3.8's `as_leaksplits()`: + # + # * its `mode_map` names only subject/batch/study/time/composite, and + # `mode_map[[src_mode]]` on a named atomic vector errors ("subscript out + # of bounds") for anything else, so the intended `subject_grouped` + # fallback on the next line is unreachable; + # * `composite` IS named, mapping to `make_split_plan(mode = "combined")`, + # but the adapter never supplies the `constraints` / `primary_axis` that + # mode requires, so it errors too. + # + # Both are pinned here so the seam is explicit. When a bioLeak release fixes + # either, this test fails on purpose: flip the affected rows to assert that + # grouping and blocking are honoured (Workstream D2 of ROADMAP-0.4.0.md). + g <- richer_contract_graph() + + for (mode in c("site", "region", "platform", "assay", "relatedness", "spatial")) { + spec <- as_split_spec(derive_split_constraints(g, mode = mode), graph = g) + expect_identical(spec$constraint_mode, mode) + expect_error( + bioLeak::as_leaksplits(spec, data = contract_data(), outcome = "y", v = 2), + info = paste("bioLeak accepted mode", mode, "- flip this test (Workstream D2)") + ) + } + + for (strategy in c("strict", "rule_based")) { + spec <- as_split_spec( + derive_split_constraints(g, mode = "composite", strategy = strategy, via = c("subject", "site")), + graph = g + ) + expect_identical(spec$constraint_mode, "composite") + expect_error( + bioLeak::as_leaksplits(spec, data = contract_data(), outcome = "y", v = 2), + info = paste("bioLeak accepted composite", strategy, "- flip this test (Workstream D2)") + ) + } +}) + +test_that("the documented workaround works: hand group_id to make_split_plan()", { + skip_if_no_bioleak() + # Until bioLeak maps the newer modes, a splitGraph grouping still reaches it: + # join `group_id` onto the observation frame and call make_split_plan() + # directly. This is the path the README and ?as_split_spec point users at, so + # it must keep working. + g <- richer_contract_graph() + spec <- as_split_spec(derive_split_constraints(g, mode = "site"), graph = g) + joined <- merge( + contract_data(), + spec$sample_data[, c("sample_id", spec$group_var)], + by = "sample_id", sort = FALSE + ) + plan <- bioLeak::make_split_plan( + joined, outcome = "y", mode = "subject_grouped", group = spec$group_var, v = 2 + ) + expect_s4_class(plan, "LeakSplits") +}) diff --git a/tests/testthat/test-conditions.R b/tests/testthat/test-conditions.R new file mode 100644 index 0000000..dc6e326 --- /dev/null +++ b/tests/testthat/test-conditions.R @@ -0,0 +1,103 @@ +# Classed conditions (see ?splitgraph_conditions). Every splitGraph error must +# inherit from "splitgraph_error", carry a `code`, and the documented +# subclasses must be raised at their representative sites. + +simple_meta <- function() { + data.frame( + sample_id = c("S1", "S2", "S3"), + subject_id = c("P1", "P1", "P2"), + batch_id = c("B1", "B2", "B1"), + stringsAsFactors = FALSE + ) +} + +expect_splitgraph_error <- function(expr, class, code = NULL) { + cond <- tryCatch(expr, error = function(e) e) + expect_s3_class(cond, "splitgraph_error") + expect_s3_class(cond, class) + expect_true(is.character(cond$code) && length(cond$code) == 1L) + if (!is.null(code)) expect_identical(cond$code, code) + invisible(cond) +} + +test_that("reference errors: unknown ids and dangling edge endpoints", { + g <- graph_from_metadata(simple_meta()) + expect_splitgraph_error(query_neighbors(g, "sample:nope"), "splitgraph_reference_error", "unknown_node_ids") + expect_splitgraph_error(derive_split_constraints(g, "subject", samples = "ghost"), + "splitgraph_reference_error", "unknown_sample_ids") + + meta <- simple_meta() + samples <- create_nodes(meta, "Sample", "sample_id") + edges <- create_edges(meta, "sample_id", "subject_id", "Sample", "Subject", "sample_belongs_to_subject") + expect_splitgraph_error(build_dependency_graph(list(samples), list(edges)), + "splitgraph_reference_error", "missing_target_node") +}) + +test_that("schema errors: unsupported node type and wrong edge signature", { + expect_splitgraph_error(create_nodes(simple_meta(), "Widget", "sample_id"), + "splitgraph_schema_error", "unsupported_node_type") + expect_splitgraph_error( + create_edges(simple_meta(), "sample_id", "subject_id", "Sample", "Batch", "sample_belongs_to_subject"), + "splitgraph_schema_error", "invalid_edge_signature" + ) +}) + +test_that("ambiguity errors: conflicting definitions and multiple assignments", { + conflicting <- data.frame( + subject_id = c("P1", "P1"), species = c("human", "mouse"), stringsAsFactors = FALSE + ) + expect_splitgraph_error(create_nodes(conflicting, "Subject", "subject_id"), + "splitgraph_ambiguity_error", "conflicting_node_definitions") + + meta <- simple_meta() + extra <- data.frame(sample_id = "S1", batch_id = "B2", stringsAsFactors = FALSE) + batch_rows <- rbind(meta[, c("sample_id", "batch_id")], extra) + g <- build_dependency_graph( + list(create_nodes(meta, "Sample", "sample_id"), create_nodes(batch_rows, "Batch", "batch_id")), + list(create_edges(batch_rows, "sample_id", "batch_id", "Sample", "Batch", "sample_processed_in_batch")), + validate = FALSE + ) + expect_splitgraph_error(derive_split_constraints(g, "batch"), + "splitgraph_ambiguity_error", "sample_multiple_batch_assignments") +}) + +test_that("validation errors are classed and carry the failure code", { + meta <- simple_meta() + extra <- data.frame(sample_id = "S1", batch_id = "B2", stringsAsFactors = FALSE) + batch_rows <- rbind(meta[, c("sample_id", "batch_id")], extra) + expect_splitgraph_error( + build_dependency_graph( + list(create_nodes(meta, "Sample", "sample_id"), create_nodes(batch_rows, "Batch", "batch_id")), + list(create_edges(batch_rows, "sample_id", "batch_id", "Sample", "Batch", "sample_processed_in_batch")) + ), + "splitgraph_validation_error", "graph_validation_failed" + ) +}) + +test_that("io errors: missing file and unparseable JSON", { + skip_if_not_installed("jsonlite") + expect_splitgraph_error(read_split_spec(tempfile(fileext = ".json")), + "splitgraph_io_error", "file_not_found") + bad <- tempfile(fileext = ".json") + writeLines("{ not json", bad) + on.exit(unlink(bad), add = TRUE) + expect_splitgraph_error(read_dependency_graph(bad), "splitgraph_io_error", "json_parse_failure") + + g <- graph_from_metadata(simple_meta()) + as_graph <- tempfile(fileext = ".json") + on.exit(unlink(as_graph), add = TRUE) + write_dependency_graph(g, as_graph) + expect_splitgraph_error(read_split_spec(as_graph), "splitgraph_schema_error", "unexpected_object_type") +}) + +test_that("plain argument errors still inherit from splitgraph_error with an NA code", { + cond <- tryCatch(ingest_metadata(list(a = 1)), error = function(e) e) + expect_s3_class(cond, "splitgraph_error") + expect_true(is.na(cond$code)) + expect_match(conditionMessage(cond), "must be a data.frame") +}) + +test_that("package warnings are classed as splitgraph_warning", { + meta <- data.frame(sample_id = c("S1", "S2"), outcome_value = c(0, 1), stringsAsFactors = FALSE) + expect_warning(graph_from_metadata(meta), class = "splitgraph_warning") +}) diff --git a/tests/testthat/test-constructors.R b/tests/testthat/test-constructors.R index 3554c94..d0d861a 100644 --- a/tests/testthat/test-constructors.R +++ b/tests/testthat/test-constructors.R @@ -23,7 +23,7 @@ test_that("create_nodes and create_edges build valid core objects", { expect_equal(igraph::ecount(as_igraph(graph)), nrow(graph$edges$data)) }) -test_that("compatibility aliases delegate to the primary constructors", { +test_that("the low-level constructors and the builder agree", { meta <- data.frame( sample_id = c("S1", "S2"), subject_id = c("P1", "P2"), @@ -31,18 +31,14 @@ test_that("compatibility aliases delegate to the primary constructors", { ) samples <- create_nodes(meta, type = "Sample", id_col = "sample_id") - # The aliases are deprecated as of 0.2.0; deprecation warnings are tested - # in test-deprecations.R, so silence them here while we verify delegation. - suppressWarnings({ - subjects <- new_depgraph_nodes(create_nodes(meta, type = "Subject", id_col = "subject_id")$data) - edges <- new_depgraph_edges( - create_edges(meta, "sample_id", "subject_id", "Sample", "Subject", "sample_belongs_to_subject")$data - ) - full_nodes <- new_depgraph_nodes(rbind(samples$data, subjects$data)) + subjects <- graph_node_set(create_nodes(meta, type = "Subject", id_col = "subject_id")$data) + edges <- graph_edge_set( + create_edges(meta, "sample_id", "subject_id", "Sample", "Subject", "sample_belongs_to_subject")$data + ) + full_nodes <- graph_node_set(rbind(samples$data, subjects$data)) - graph <- new_depgraph(nodes = full_nodes, edges = edges) - graph2 <- build_depgraph(nodes = list(samples, subjects), edges = list(edges)) - }) + graph <- dependency_graph(nodes = full_nodes, edges = edges, graph = NULL) + graph2 <- build_dependency_graph(nodes = list(samples, subjects), edges = list(edges)) expect_s3_class(subjects, "graph_node_set") expect_s3_class(edges, "graph_edge_set") diff --git a/tests/testthat/test-contract-0-4-0.R b/tests/testthat/test-contract-0-4-0.R new file mode 100644 index 0000000..4fda462 --- /dev/null +++ b/tests/testthat/test-contract-0-4-0.R @@ -0,0 +1,303 @@ +# Contract additions of the 0.4.0 cycle: the stratum annotation, pairwise +# sources inside composite derivations, edge-set provenance, and the +# cross-site leakage rule. + +test_that("as_split_spec fills stratum from sample-level outcomes", { + meta <- data.frame( + sample_id = c("S1", "S2", "S3", "S4"), + subject_id = c("P1", "P1", "P2", "P2"), + outcome_id = c("case", "case", "ctrl", "ctrl"), + stringsAsFactors = FALSE + ) + g <- graph_from_metadata(meta) + spec <- as_split_spec(derive_split_constraints(g, "subject"), graph = g) + + expect_identical(spec$stratum_var, "stratum") + expect_identical(spec$sample_data$stratum, c("case", "case", "ctrl", "ctrl")) + expect_true(validate_split_spec(spec)$valid) + # Without a graph nothing can be enriched: stratum stays NA and stratum_var NULL. + bare <- as_split_spec(derive_split_constraints(g, "subject")) + expect_null(bare$stratum_var) + expect_true(all(is.na(bare$sample_data$stratum))) +}) + +test_that("stratum falls back to subject-level outcomes and stays NA when ambiguous", { + meta <- data.frame( + sample_id = c("S1", "S2", "S3"), + subject_id = c("P1", "P1", "P2"), + outcome_id = c("case", "case", "ctrl"), + stringsAsFactors = FALSE + ) + g <- graph_from_metadata(meta, outcome_scope = "subject") + spec <- as_split_spec(derive_split_constraints(g, "subject"), graph = g) + expect_identical(spec$sample_data$stratum, c("case", "case", "ctrl")) + + # A sample linked to two outcomes has no unique stratum. + samples <- create_nodes(meta, "Sample", "sample_id") + outcomes <- create_nodes(data.frame(outcome_id = c("a", "b")), "Outcome", "outcome_id") + links <- data.frame(sample_id = c("S1", "S1", "S2"), outcome_id = c("a", "b", "a")) + g2 <- build_dependency_graph( + list(samples, outcomes), + list(create_edges(links, "sample_id", "outcome_id", "Sample", "Outcome", "sample_has_outcome")), + validate = FALSE + ) + con <- derive_split_constraints(g2, "composite", via = "subject") + spec2 <- as_split_spec(con, graph = g2) + expect_identical(spec2$sample_data$stratum, c(NA, "a", NA)) + v <- validate_split_spec(spec2) + expect_true("partial_stratum" %in% v$issues$code) +}) + +test_that("stratum and stratum_var round-trip through JSON and the schema validator", { + skip_if_not_installed("jsonlite") + meta <- data.frame(sample_id = c("S1", "S2"), subject_id = c("P1", "P2"), outcome_id = c("a", "b")) + g <- graph_from_metadata(meta) + spec <- as_split_spec(derive_split_constraints(g, "subject"), graph = g) + tmp <- tempfile(fileext = ".json") + on.exit(unlink(tmp), add = TRUE) + write_split_spec(spec, tmp) + raw <- jsonlite::fromJSON(tmp, simplifyVector = FALSE) + expect_identical(raw$stratum_var, "stratum") + expect_identical(raw$sample_data[[1]]$stratum, "a") + expect_true(validate_split_spec_json(tmp)$valid) + back <- read_split_spec(tmp) + expect_identical(back$stratum_var, "stratum") + expect_identical(back$sample_data$stratum, spec$sample_data$stratum) + # Provenance additions are arrays / scalars of the declared types. + expect_type(raw$metadata$via, "list") + expect_true(is.null(raw$metadata$threshold) || is.numeric(raw$metadata$threshold) || is.na(raw$metadata$threshold)) + expect_type(raw$metadata$igraph_version, "character") +}) + +test_that("composite strict accepts pairwise sources alongside direct ones", { + meta <- data.frame( + sample_id = c("S1", "S2", "S3", "S4"), + subject_id = c("P1", "P2", "P3", "P4"), + batch_id = c("B1", "B1", "B2", "B3"), + stringsAsFactors = FALSE + ) + pairs <- data.frame(id1 = "P2", id2 = "P3", kinship = 0.25, stringsAsFactors = FALSE) + g <- build_dependency_graph( + list(create_nodes(meta, "Sample", "sample_id"), create_nodes(meta, "Subject", "subject_id"), create_nodes(meta, "Batch", "batch_id")), + list( + create_edges(meta, "sample_id", "subject_id", "Sample", "Subject", "sample_belongs_to_subject"), + create_edges(meta, "sample_id", "batch_id", "Sample", "Batch", "sample_processed_in_batch"), + relatedness_edges_from_kinship(pairs, threshold = 0.1) + ) + ) + + # batch alone: {S1,S2}, {S3}, {S4}; relatedness alone: {S2,S3}; combined: {S1,S2,S3}, {S4}. + con <- derive_split_constraints(g, "composite", via = c("batch", "relatedness")) + gv <- grouping_vector(con) + expect_identical(gv[["S1"]], gv[["S2"]]) + expect_identical(gv[["S2"]], gv[["S3"]]) + expect_false(gv[["S3"]] == gv[["S4"]]) + expect_identical(con$metadata$via, c("Batch", "relatedness")) + expect_setequal(con$metadata$relations_used, c("sample_processed_in_batch", "subject_related_to")) + + # The relation name is accepted as an alias for the mode. + con2 <- derive_split_constraints(g, "composite", via = c("Batch", "subject_related_to")) + expect_identical(grouping_vector(con2), gv) +}) + +test_that("rule-based composite treats a pairwise source as a fallback", { + meta <- data.frame( + sample_id = c("S1", "S2", "S3", "S4"), + subject_id = c("P1", "P2", "P3", "P4"), + batch_id = c("B1", NA, NA, NA), + stringsAsFactors = FALSE + ) + pairs <- data.frame(id1 = "P2", id2 = "P3", kinship = 0.5, stringsAsFactors = FALSE) + g <- build_dependency_graph( + list(create_nodes(meta, "Sample", "sample_id"), create_nodes(meta, "Subject", "subject_id"), create_nodes(meta, "Batch", "batch_id")), + list( + create_edges(meta, "sample_id", "subject_id", "Sample", "Subject", "sample_belongs_to_subject"), + create_edges(meta, "sample_id", "batch_id", "Sample", "Batch", "sample_processed_in_batch", allow_missing = TRUE), + relatedness_edges_from_kinship(pairs, threshold = 0.1) + ) + ) + con <- derive_split_constraints(g, "composite", strategy = "rule_based", + via = c("batch", "relatedness"), priority = c("batch", "relatedness")) + sm <- con$sample_map + expect_identical(sm$constraint_type[sm$sample_id == "S1"], "batch") + expect_identical(sm$constraint_type[sm$sample_id == "S2"], "relatedness") + expect_identical(sm$group_id[sm$sample_id == "S2"], sm$group_id[sm$sample_id == "S3"]) + # S4: no batch, singleton relatedness component -> unlinked. + expect_identical(sm$constraint_type[sm$sample_id == "S4"], "unlinked") + expect_identical(con$metadata$priority, c("batch", "relatedness")) +}) + +test_that("thresholds are recorded on the edge set, the graph, and the split_spec", { + meta <- data.frame(sample_id = c("S1", "S2"), subject_id = c("P1", "P2"), stringsAsFactors = FALSE) + pairs <- data.frame(id1 = "P1", id2 = "P2", kinship = 0.4, stringsAsFactors = FALSE) + rel <- relatedness_edges_from_kinship(pairs, threshold = 0.125) + expect_identical(rel$source$threshold, 0.125) + expect_identical(rel$source$metric, "kinship") + + coords <- data.frame(sample_id = c("S1", "S2"), x = c(0, 1), y = c(0, 0)) + sp <- spatial_edges_from_coords(coords, radius = 2) + expect_identical(sp$source$threshold, 2) + expect_identical(sp$source$metric, "distance") + + g <- build_dependency_graph( + list(create_nodes(meta, "Sample", "sample_id"), create_nodes(meta, "Subject", "subject_id")), + list(create_edges(meta, "sample_id", "subject_id", "Sample", "Subject", "sample_belongs_to_subject"), rel, sp) + ) + expect_identical(g$metadata$edge_sources$subject_related_to$threshold, 0.125) + expect_identical(g$metadata$edge_sources$sample_adjacent_to$threshold, 2) + + con <- derive_split_constraints(g, "relatedness") + expect_identical(con$metadata$threshold, 0.125) + expect_identical(con$metadata$threshold_metric, "kinship") + spec <- as_split_spec(con, graph = g) + expect_identical(spec$metadata$threshold, 0.125) + + skip_if_not_installed("jsonlite") + tmp <- tempfile(fileext = ".json") + on.exit(unlink(tmp), add = TRUE) + write_dependency_graph(g, tmp) + back <- read_dependency_graph(tmp) + expect_identical(back$metadata$edge_sources$subject_related_to$threshold, 0.125) + expect_true(validate_graph_json(tmp)$valid) +}) + +test_that("a subject collected at several sites raises subject_cross_site_overlap", { + meta <- data.frame( + sample_id = c("S1", "S2", "S3"), + subject_id = c("P1", "P1", "P2"), + site_id = c("NYC", "BOS", "NYC"), + stringsAsFactors = FALSE + ) + g <- graph_from_metadata(meta) + report <- validate_graph(g) + hit <- report$issues[report$issues$code == "subject_cross_site_overlap", ] + expect_identical(nrow(hit), 1L) + expect_identical(hit$severity, "warning") + expect_true(all(c("subject:P1", "sample:S1", "sample:S2", "site:NYC", "site:BOS") %in% hit$node_ids[[1]])) + + # Severed by subject or site grouping, not by batch grouping. + risks_subject <- as.data.frame(summarize_leakage_risks(g, constraint = derive_split_constraints(g, "subject"))) + risks_site <- as.data.frame(summarize_leakage_risks(g, constraint = derive_split_constraints(g, "site"))) + expect_true(risks_subject$severed[risks_subject$category == "subject_cross_site_overlap"]) + expect_true(risks_site$severed[risks_site$category == "subject_cross_site_overlap"]) +}) + +test_that("review fixes: overrides serialise as an object, empty edge sets add cleanly, thresholds round-trip", { + skip_if_not_installed("jsonlite") + g <- graph_from_metadata(data.frame(sample_id = c("S1", "S2"), subject_id = c("P1", "P2"))) + f <- tempfile(fileext = ".json") + on.exit(unlink(f), add = TRUE) + write_dependency_graph(g, f) + raw <- jsonlite::fromJSON(f, simplifyVector = FALSE) + expect_true(is.list(raw$metadata$validation_overrides)) + expect_false(any(grepl('"validation_overrides": []', readLines(f), fixed = TRUE))) + expect_true(any(grepl('"validation_overrides": {}', readLines(f), fixed = TRUE))) + + # The R-side validator rejects an array where the schema wants an object, + # including the EMPTY array that the writer used to produce (jsonlite + # distinguishes `{}` from `[]` by names, so the validator must too). + write_array <- function(value) { + raw$metadata$validation_overrides <- value + writeLines(jsonlite::toJSON(raw, auto_unbox = TRUE, null = "null", na = "null"), f) + validate_graph_json(f) + } + empty_report <- write_array(list()) + # `toJSON()` without `pretty` writes compact text, so match on the parsed + # value rather than on spacing: an empty JSON array parses to a list with + # NULL names, an empty object to one with `character(0)` names. + expect_null(names(jsonlite::fromJSON(f, simplifyVector = FALSE)$metadata$validation_overrides)) + expect_false(empty_report$valid) + expect_true(any(grepl("validation_overrides", empty_report$issues))) + expect_false(write_array(list("x"))$valid) + expect_error(read_dependency_graph(f, validate = TRUE), class = "splitgraph_schema_error") + # An empty object still passes, and so does an empty attrs entry. + expect_true(splitGraph:::.depgraph_is_json_object(jsonlite::fromJSON("{}", simplifyVector = FALSE))) + expect_false(splitGraph:::.depgraph_is_json_object(jsonlite::fromJSON("[]", simplifyVector = FALSE))) + + # build_dependency_graph refuses an unnamed overrides list up front. + expect_error( + graph_from_metadata(data.frame(sample_id = "S1", subject_id = "P1"), + validation_overrides = list(TRUE)), + class = "splitgraph_error" + ) + + # Nothing the package can write may fail its own validator: a hand-built + # spec with no metadata, a spec with an explicitly empty metadata list, and + # an edgeless graph all have empty objects/arrays in awkward places. + bare <- tempfile(fileext = ".json") + on.exit(unlink(bare), add = TRUE) + write_split_spec(split_spec(), bare) + expect_true(validate_split_spec_json(bare)$valid) + write_split_spec( + split_spec(sample_data = data.frame(sample_id = "S1", group_id = "g1", stringsAsFactors = FALSE), + metadata = list()), + bare + ) + expect_true(validate_split_spec_json(bare)$valid) + expect_s3_class(read_split_spec(bare, validate = TRUE), "split_spec") + + edgeless <- build_dependency_graph( + list(create_nodes(data.frame(sample_id = c("S1", "S2")), "Sample", "sample_id")), + list(graph_edge_set()), validate = FALSE + ) + eg <- tempfile(fileext = ".json") + on.exit(unlink(eg), add = TRUE) + write_dependency_graph(edgeless, eg) + expect_true(validate_graph_json(eg)$valid) + expect_identical(nrow(read_dependency_graph(eg, validate = TRUE)$edges$data), 0L) + + # add_edges() with an edge set in which nothing passed the threshold + empty <- relatedness_edges_from_kinship(data.frame(id1 = "P1", id2 = "P2", kinship = 0.01), threshold = 0.1) + expect_identical(nrow(empty$data), 0L) + g2 <- add_edges(g, empty) + expect_identical(nrow(g2$edges$data), nrow(g$edges$data)) + expect_identical(g2$metadata$edge_sources$subject_related_to$threshold, 0.1) + + # threshold / threshold_metric round-trip as typed NA on non-pairwise specs + spec <- as_split_spec(derive_split_constraints(g, "subject"), graph = g) + sf <- tempfile(fileext = ".json") + on.exit(unlink(sf), add = TRUE) + write_split_spec(spec, sf) + back <- read_split_spec(sf) + expect_identical(back$metadata$threshold, NA_real_) + expect_identical(back$metadata$threshold_metric, NA_character_) + expect_true(isTRUE(all.equal(back$metadata[setdiff(names(back$metadata), "derived_at")], + spec$metadata[setdiff(names(spec$metadata), "derived_at")]))) +}) + +test_that("an ambiguous sample-level outcome stays NA instead of borrowing the subject outcome", { + meta <- data.frame(sample_id = c("S1", "S2"), subject_id = c("P1", "P1"), stringsAsFactors = FALSE) + outcomes <- create_nodes(data.frame(outcome_id = c("case", "ctrl")), "Outcome", "outcome_id") + links <- data.frame(sample_id = c("S1", "S1"), outcome_id = c("case", "ctrl")) + subj_out <- data.frame(subject_id = "P1", outcome_id = "case") + g <- build_dependency_graph( + list(create_nodes(meta, "Sample", "sample_id"), create_nodes(meta, "Subject", "subject_id"), outcomes), + list( + create_edges(meta, "sample_id", "subject_id", "Sample", "Subject", "sample_belongs_to_subject"), + create_edges(links, "sample_id", "outcome_id", "Sample", "Outcome", "sample_has_outcome"), + create_edges(subj_out, "subject_id", "outcome_id", "Subject", "Outcome", "subject_has_outcome") + ), + validate = FALSE + ) + spec <- as_split_spec(derive_split_constraints(g, "subject"), graph = g) + # S1 is ambiguous so its stratum stays NA; S2 inherits the subject outcome. + expect_identical(spec$sample_data$stratum, c(NA, "case")) +}) + +test_that("invalid mode / strategy / format / focus arguments raise classed errors", { + g <- graph_from_metadata(data.frame(sample_id = c("S1", "S2"), subject_id = c("P1", "P2"))) + expect_error(derive_split_constraints(g, mode = "bogus"), class = "splitgraph_error") + expect_error(derive_split_constraints(g, mode = "composite", strategy = "loose"), class = "splitgraph_error") + expect_error(export_graph(g, tempfile(), format = "dot"), class = "splitgraph_error") + pdf(NULL) + on.exit(dev.off(), add = TRUE) + expect_error(plot(g, focus = "sideways"), class = "splitgraph_error") + expect_error(graph_from_metadata(data.frame(sample_id = "S1"), outcome_scope = "cohort"), class = "splitgraph_error") + # query traversal arguments are classed too + expect_error(query_neighbors(g, "sample:S1", direction = "sideways"), class = "splitgraph_error") + expect_error(query_paths(g, "sample:S1", "sample:S2", mode = "backwards"), class = "splitgraph_error") + expect_error(query_shortest_paths(g, "sample:S1", "sample:S2", mode = "backwards"), class = "splitgraph_error") + # partial matching still works, as with match.arg() + expect_s3_class(derive_split_constraints(g, mode = "subj"), "split_constraint") + expect_identical(as.data.frame(query_neighbors(g, "sample:S1", direction = "o"))$direction[[1]], "out") +}) diff --git a/tests/testthat/test-deprecations.R b/tests/testthat/test-deprecations.R index c01892e..789b793 100644 --- a/tests/testthat/test-deprecations.R +++ b/tests/testthat/test-deprecations.R @@ -1,3 +1,7 @@ +# The 0.1-era aliases were deprecated in 0.2.0 and removed in 0.4.0. These +# tests pin the removal so the names cannot silently come back, and check the +# canonical replacements work without warnings. + make_simple_graph <- function() { meta <- data.frame( sample_id = c("S1", "S2"), @@ -13,86 +17,33 @@ make_simple_graph <- function() { build_dependency_graph(list(samples, subjects), list(edges)) } -test_that("validate_graph(checks = ...) is deprecated but still works", { - g <- make_simple_graph() - - # Default call (no `checks` supplied) must NOT warn. - expect_silent(validate_graph(g)) - - # Explicit `checks` triggers a deprecation warning. - expect_warning( - report <- validate_graph(g, checks = c("ids", "references")), - "deprecated", - ignore.case = TRUE +test_that("the removed 0.1-era aliases are no longer exported", { + removed <- c( + "new_depgraph", "new_depgraph_nodes", "new_depgraph_edges", + "build_depgraph", "validate_depgraph" ) - expect_s3_class(report, "depgraph_validation_report") - expect_true(report$valid) + exported <- getNamespaceExports("splitGraph") + expect_false(any(removed %in% exported)) + for (name in removed) { + expect_false(exists(name, envir = asNamespace("splitGraph"), inherits = FALSE), info = name) + } }) -test_that("validate_graph() recommended path (levels=) is silent and equivalent", { +test_that("validate_graph() no longer accepts the removed `checks` argument", { g <- make_simple_graph() - - expect_silent(report <- validate_graph(g, levels = c("structural", "semantic"))) - expect_s3_class(report, "depgraph_validation_report") - expect_true(report$valid) + expect_error(validate_graph(g, checks = c("ids", "references")), "unused argument") }) -test_that("alias functions are deprecated but still functional", { - meta <- data.frame( - sample_id = c("S1", "S2"), - subject_id = c("P1", "P2"), - stringsAsFactors = FALSE - ) - samples <- create_nodes(meta, type = "Sample", id_col = "sample_id") - subjects <- create_nodes(meta, type = "Subject", id_col = "subject_id") - edges <- create_edges( - meta, "sample_id", "subject_id", - "Sample", "Subject", "sample_belongs_to_subject" - ) - - expect_warning( - g <- build_depgraph(list(samples, subjects), list(edges)), - "deprecated", ignore.case = TRUE - ) - expect_s3_class(g, "dependency_graph") +test_that("validate_graph() recommended path (levels=) is silent", { + g <- make_simple_graph() - expect_warning( - report <- validate_depgraph(g), - "deprecated", ignore.case = TRUE - ) + expect_silent(report <- validate_graph(g, levels = c("structural", "semantic"))) expect_s3_class(report, "depgraph_validation_report") - - # Constructor aliases. - expect_warning( - n <- new_depgraph_nodes(), - "deprecated", ignore.case = TRUE - ) - expect_s3_class(n, "graph_node_set") - - expect_warning( - e <- new_depgraph_edges(), - "deprecated", ignore.case = TRUE - ) - expect_s3_class(e, "graph_edge_set") - - # new_depgraph wraps dependency_graph(), which expects already-bound - # node/edge sets — we mimic build_dependency_graph()'s assembly: - bound_nodes <- graph_node_set(rbind( - as.data.frame(create_nodes(meta, "Sample", "sample_id")), - as.data.frame(create_nodes(meta, "Subject", "subject_id")) - )) - bound_edges <- create_edges( - meta, "sample_id", "subject_id", - "Sample", "Subject", "sample_belongs_to_subject" - ) - expect_warning( - nd <- new_depgraph(nodes = bound_nodes, edges = bound_edges, graph = NULL), - "deprecated", ignore.case = TRUE - ) - expect_s3_class(nd, "dependency_graph") + expect_true(report$valid) + expect_identical(report$metadata$levels, c("structural", "semantic")) }) -test_that("the canonical (non-deprecated) constructors produce no warnings", { +test_that("the canonical constructors produce no warnings", { meta <- data.frame( sample_id = c("S1", "S2"), subject_id = c("P1", "P2"), @@ -112,4 +63,9 @@ test_that("the canonical (non-deprecated) constructors produce no warnings", { "Sample", "Subject", "sample_belongs_to_subject" ) expect_silent(build_dependency_graph(list(samples, subjects), list(edges))) + expect_silent(dependency_graph( + nodes = graph_node_set(rbind(samples$data, subjects$data)), + edges = edges, + graph = NULL + )) }) diff --git a/tests/testthat/test-export.R b/tests/testthat/test-export.R new file mode 100644 index 0000000..94189e4 --- /dev/null +++ b/tests/testthat/test-export.R @@ -0,0 +1,63 @@ +export_graph_fixture <- function() { + meta <- data.frame( + sample_id = c("S1", "S2", "S3"), + subject_id = c("P1", "P1", "P2"), + batch_id = c("B1", "B2", "B1"), + sample_role = c("case", "control", "case"), + stringsAsFactors = FALSE + ) + graph_from_metadata(meta, graph_name = "export-demo") +} + +test_that("export_graph writes GraphML that igraph reads back with attributes", { + g <- export_graph_fixture() + tmp <- tempfile(fileext = ".graphml") + on.exit(unlink(tmp), add = TRUE) + out <- export_graph(g, tmp, format = "graphml") + expect_true(file.exists(tmp)) + expect_type(out, "character") + + back <- igraph::read_graph(tmp, format = "graphml") + expect_equal(igraph::vcount(back), nrow(g$nodes$data)) + expect_equal(igraph::ecount(back), nrow(g$edges$data)) + expect_true("node_type" %in% igraph::vertex_attr_names(back)) + expect_true("attr_sample_role" %in% igraph::vertex_attr_names(back)) + expect_true("edge_type" %in% igraph::edge_attr_names(back)) + roles <- igraph::vertex_attr(back, "attr_sample_role") + expect_setequal(roles[igraph::vertex_attr(back, "node_type") == "Sample"], c("case", "control", "case")) +}) + +test_that("export_graph writes GML and CSV tables", { + g <- export_graph_fixture() + gml <- tempfile(fileext = ".gml") + nodes_csv <- tempfile(fileext = ".csv") + edges_csv <- tempfile(fileext = ".csv") + on.exit(unlink(c(gml, nodes_csv, edges_csv)), add = TRUE) + + export_graph(g, gml, format = "gml") + expect_equal(igraph::vcount(igraph::read_graph(gml, format = "gml")), nrow(g$nodes$data)) + # The writer is given explicit node ids, because leaving igraph's `id` at its + # NULL default fails in some igraph versions. Assert they are actually there, + # one per node, so a regression cannot pass silently. + gml_lines <- readLines(gml) + expect_identical(sum(grepl("^[[:space:]]*id [0-9]+$", gml_lines)), nrow(g$nodes$data)) + + export_graph(g, nodes_csv, format = "nodes_csv") + nodes <- utils::read.csv(nodes_csv, stringsAsFactors = FALSE) + expect_identical(nrow(nodes), nrow(g$nodes$data)) + expect_true(all(c("node_id", "node_type", "node_key", "label", "attr_sample_role") %in% names(nodes))) + + export_graph(g, edges_csv, format = "edges_csv") + edges <- utils::read.csv(edges_csv, stringsAsFactors = FALSE) + expect_identical(nrow(edges), nrow(g$edges$data)) + expect_true(all(c("from", "to", "edge_id", "edge_type") %in% names(edges))) +}) + +test_that("attribute flattening keeps numeric columns numeric and collapses vectors", { + attrs <- list(list(a = 1, b = "x"), list(a = 2.5), list(b = c("y", "z"), c = TRUE)) + flat <- splitGraph:::.depgraph_flatten_attrs(attrs) + expect_identical(names(flat), c("attr_a", "attr_b", "attr_c")) + expect_type(flat$attr_a, "double") + expect_identical(flat$attr_b, c("x", NA, "y;z")) + expect_identical(flat$attr_c, c(NA, NA, TRUE)) +}) diff --git a/tests/testthat/test-graph-edit.R b/tests/testthat/test-graph-edit.R new file mode 100644 index 0000000..3bf113b --- /dev/null +++ b/tests/testthat/test-graph-edit.R @@ -0,0 +1,107 @@ +edit_meta <- function() { + data.frame( + sample_id = c("S1", "S2", "S3", "S4", "S5"), + subject_id = c("P1", "P1", "P2", "P3", "P3"), + batch_id = c("B1", "B1", "B2", "B2", "B3"), + timepoint_id = c("T1", "T2", "T1", "T2", "T3"), + time_index = c(1, 2, 1, 2, 3), + stringsAsFactors = FALSE + ) +} + +test_that("subset_graph keeps only the requested samples and their structure", { + g <- graph_from_metadata(edit_meta(), graph_name = "full") + g_sub <- subset_graph(g, samples = c("S1", "S2")) + + expect_s3_class(g_sub, "dependency_graph") + expect_setequal(g_sub$nodes$data$node_key[g_sub$nodes$data$node_type == "Sample"], c("S1", "S2")) + expect_setequal(g_sub$nodes$data$node_key[g_sub$nodes$data$node_type == "Subject"], "P1") + expect_setequal(g_sub$nodes$data$node_key[g_sub$nodes$data$node_type == "Batch"], "B1") + expect_setequal(g_sub$nodes$data$node_key[g_sub$nodes$data$node_type == "Timepoint"], c("T1", "T2")) + # Only the precedence edge between retained timepoints survives. + prec <- g_sub$edges$data[g_sub$edges$data$edge_type == "timepoint_precedes", ] + expect_identical(nrow(prec), 1L) + expect_true(validate_graph(g_sub)$valid) + expect_identical(g_sub$metadata$graph_name, "full") + expect_identical(g_sub$metadata$subset_of, "full") + expect_identical(g_sub$metadata$n_samples_before_subset, 5L) + # Input untouched. + expect_identical(nrow(g$nodes$data), 5L + 3L + 3L + 3L) +}) + +test_that("subset_graph matches derive_split_constraints(samples =) semantics", { + g <- graph_from_metadata(edit_meta()) + sub <- c("S1", "S3", "S4") + direct <- grouping_vector(derive_split_constraints(g, "composite", samples = sub)) + via_subset <- grouping_vector(derive_split_constraints(subset_graph(g, sub), "composite")) + canon <- function(x) as.integer(match(x, unique(x))) + expect_identical(canon(direct), canon(via_subset)) +}) + +test_that("subset_graph rejects unknown samples with a reference error", { + g <- graph_from_metadata(edit_meta()) + expect_error(subset_graph(g, samples = c("S1", "ghost")), class = "splitgraph_reference_error") +}) + +test_that("combine_graphs unions nodes and edges and renumbers edge ids", { + m1 <- edit_meta()[1:3, ] + m2 <- edit_meta()[3:5, ] + g1 <- graph_from_metadata(m1, graph_name = "part1") + g2 <- graph_from_metadata(m2, graph_name = "part2") + g <- combine_graphs(g1, g2) + + expect_s3_class(g, "dependency_graph") + expect_setequal(g$nodes$data$node_key[g$nodes$data$node_type == "Sample"], paste0("S", 1:5)) + expect_false(anyDuplicated(g$edges$data$edge_id) > 0) + expect_false(anyDuplicated(paste(g$edges$data$from, g$edges$data$to, g$edges$data$edge_type)) > 0) + expect_identical(g$metadata$graph_name, "part1") + expect_identical(g$metadata$combined_from, c("part1", "part2")) + + # Same grouping as building from the full table. + full <- graph_from_metadata(edit_meta()) + expect_identical( + grouping_vector(derive_split_constraints(g, "subject"))[paste0("S", 1:5)], + grouping_vector(derive_split_constraints(full, "subject"))[paste0("S", 1:5)] + ) + # A list of graphs is accepted too. + expect_identical(nrow(combine_graphs(list(g1, g2))$nodes$data), nrow(g$nodes$data)) +}) + +test_that("combine_graphs rejects conflicting node definitions", { + m <- data.frame(subject_id = "P1", species = "human", stringsAsFactors = FALSE) + base <- data.frame(sample_id = "S1", subject_id = "P1", stringsAsFactors = FALSE) + g1 <- build_dependency_graph( + list(create_nodes(base, "Sample", "sample_id"), create_nodes(m, "Subject", "subject_id")), + list(create_edges(base, "sample_id", "subject_id", "Sample", "Subject", "sample_belongs_to_subject")) + ) + m2 <- m + m2$species <- "mouse" + g2 <- build_dependency_graph( + list(create_nodes(base, "Sample", "sample_id"), create_nodes(m2, "Subject", "subject_id")), + list(create_edges(base, "sample_id", "subject_id", "Sample", "Subject", "sample_belongs_to_subject")) + ) + expect_error(combine_graphs(g1, g2), class = "splitgraph_ambiguity_error") +}) + +test_that("add_edges appends an edge set, keeps existing ids, and records provenance", { + g <- graph_from_metadata(edit_meta()) + before_ids <- g$edges$data$edge_id + pairs <- data.frame(id1 = "P1", id2 = "P2", kinship = 0.3, stringsAsFactors = FALSE) + g2 <- add_edges(g, relatedness_edges_from_kinship(pairs, threshold = 0.1)) + + expect_true(all(before_ids %in% g2$edges$data$edge_id)) + expect_identical(sum(g2$edges$data$edge_type == "subject_related_to"), 1L) + expect_identical(g2$metadata$edge_sources$subject_related_to$threshold, 0.1) + groups <- grouping_vector(derive_split_constraints(g2, "relatedness")) + expect_identical(groups[["S1"]], groups[["S3"]]) + expect_false(groups[["S1"]] == groups[["S4"]]) + + # Adding the same edges again is a no-op (exact duplicates collapse). + g3 <- add_edges(g2, relatedness_edges_from_kinship(pairs, threshold = 0.1)) + expect_identical(nrow(g3$edges$data), nrow(g2$edges$data)) + + # Edges to unknown nodes are a reference error. + bad <- data.frame(id1 = "P1", id2 = "P99", kinship = 0.3, stringsAsFactors = FALSE) + expect_error(add_edges(g, relatedness_edges_from_kinship(bad, threshold = 0.1)), + class = "splitgraph_reference_error") +}) diff --git a/tests/testthat/test-graph-from-metadata.R b/tests/testthat/test-graph-from-metadata.R index d6f3325..cea39c6 100644 --- a/tests/testthat/test-graph-from-metadata.R +++ b/tests/testthat/test-graph-from-metadata.R @@ -49,3 +49,68 @@ test_that("graph_from_metadata supports subject-scope outcome", { expect_true("subject_has_outcome" %in% edge_types) expect_false("sample_has_outcome" %in% edge_types) }) + +test_that("graph_from_metadata accepts factor and numeric site/region/platform ids", { + meta <- data.frame( + sample_id = c("S1", "S2", "S3"), + subject_id = c("P1", "P2", "P3"), + site_id = factor(c("A", "B", "A")), + region_id = factor(c("cortex", "cortex", "liver")), + platform_id = c(1, 2, 1), + stringsAsFactors = FALSE + ) + + ingested <- ingest_metadata(meta) + expect_type(ingested$site_id, "character") + expect_type(ingested$region_id, "character") + expect_type(ingested$platform_id, "character") + + g <- graph_from_metadata(meta) + expect_s3_class(g, "dependency_graph") + expect_setequal( + g$nodes$data$node_key[g$nodes$data$node_type == "Site"], + c("A", "B") + ) + expect_setequal( + g$nodes$data$node_key[g$nodes$data$node_type == "Platform"], + c("1", "2") + ) + expect_identical( + unname(grouping_vector(derive_split_constraints(g, mode = "site"))), + c("site:A", "site:B", "site:A") + ) +}) + +test_that("create_nodes accepts a factor identifier column directly", { + nodes <- create_nodes(data.frame(site_id = factor(c("A", "B", "A"))), "Site", "site_id") + expect_identical(nodes$data$node_key, c("A", "B")) +}) + +test_that("a metadata table with only sample_id yields an edgeless graph", { + # `sample_id` is documented as the only required column, so this must build + # rather than fail in the edge binder with an internal message. + g <- graph_from_metadata(data.frame(sample_id = c("S1", "S2"), stringsAsFactors = FALSE)) + expect_s3_class(g, "dependency_graph") + expect_identical(nrow(g$nodes$data), 2L) + expect_identical(nrow(g$edges$data), 0L) + expect_true(validate_graph(g)$valid) + + # the rest of the pipeline still works on it + con <- derive_split_constraints(g, "subject") + expect_length(grouping_vector(con), 2L) + spec <- as_split_spec(con, graph = g) + expect_s3_class(spec, "split_spec") + + # columns that are not canonical are ignored, not fatal + expect_s3_class( + graph_from_metadata(data.frame(sample_id = c("S1", "S2"), extra = c(1, 2))), + "dependency_graph" + ) + + skip_if_not_installed("jsonlite") + tmp <- tempfile(fileext = ".json") + on.exit(unlink(tmp), add = TRUE) + write_dependency_graph(g, tmp) + expect_true(validate_graph_json(tmp)$valid) + expect_identical(nrow(read_dependency_graph(tmp, validate = TRUE)$edges$data), 0L) +}) diff --git a/tests/testthat/test-json-schema.R b/tests/testthat/test-json-schema.R index 17eef4f..0011975 100644 --- a/tests/testthat/test-json-schema.R +++ b/tests/testthat/test-json-schema.R @@ -34,7 +34,7 @@ test_that("written JSON carries a $schema reference and the current version", { raw <- jsonlite::fromJSON(tmp, simplifyVector = FALSE) expect_match(raw$`$schema`, "dependency_graph\\.schema\\.json$") - expect_identical(raw$schema_version, "0.2.0") + expect_identical(raw$schema_version, "0.3.0") expect_identical(raw$schema_version, splitGraph:::.depgraph_schema_version) }) @@ -57,7 +57,7 @@ test_that("validate_graph_json flags dangling edge endpoints and unknown types", skip_if_no_jsonlite() bad <- list( splitGraph_object = "dependency_graph", - schema_version = "0.2.0", + schema_version = "0.3.0", nodes = list(list(node_id = "sample:S1", node_type = "Sample", node_key = "S1")), edges = list(list( edge_id = "e1", from = "sample:S1", to = "subject:P9", @@ -99,7 +99,7 @@ test_that("validate_split_spec_json passes a well-formed spec and flags missing bad <- list( splitGraph_object = "split_spec", - schema_version = "0.2.0", + schema_version = "0.3.0", group_var = "group_id", sample_data = list(list(sample_id = "S1")) # missing group_id ) @@ -160,7 +160,7 @@ test_that("migrate_split_spec_json upgrades an old-version file to current", { migrate_split_spec_json(tmp) raw <- jsonlite::fromJSON(tmp, simplifyVector = FALSE) - expect_identical(raw$schema_version, "0.2.0") + expect_identical(raw$schema_version, "0.3.0") expect_match(raw$`$schema`, "split_spec\\.schema\\.json$") # New columns are now present in every row. row1 <- raw$sample_data[[1L]] @@ -205,19 +205,21 @@ test_that("validate_graph_json flags malformed and non-array node collections", skip_if_no_jsonlite() # Node missing required fields. missing_fields <- list( - splitGraph_object = "dependency_graph", schema_version = "0.2.0", + splitGraph_object = "dependency_graph", schema_version = "0.3.0", nodes = list(list(node_id = "sample:S1")), edges = list() ) - tmp1 <- tempfile(fileext = ".json"); on.exit(unlink(tmp1), add = TRUE) + tmp1 <- tempfile(fileext = ".json") + on.exit(unlink(tmp1), add = TRUE) writeLines(jsonlite::toJSON(missing_fields, auto_unbox = TRUE, null = "null"), tmp1) expect_true(any(grepl("required strings", validate_graph_json(tmp1)$issues))) # `nodes` is a scalar, not an array. not_array <- list( - splitGraph_object = "dependency_graph", schema_version = "0.2.0", + splitGraph_object = "dependency_graph", schema_version = "0.3.0", nodes = "oops", edges = list() ) - tmp2 <- tempfile(fileext = ".json"); on.exit(unlink(tmp2), add = TRUE) + tmp2 <- tempfile(fileext = ".json") + on.exit(unlink(tmp2), add = TRUE) writeLines(jsonlite::toJSON(not_array, auto_unbox = TRUE, null = "null"), tmp2) expect_true(any(grepl("`nodes` must be an array", validate_graph_json(tmp2)$issues))) }) @@ -260,7 +262,7 @@ test_that("migrate_dependency_graph_json upgrades an old-version graph file", { migrate_dependency_graph_json(tmp) out <- jsonlite::fromJSON(tmp, simplifyVector = FALSE) - expect_identical(out$schema_version, "0.2.0") + expect_identical(out$schema_version, "0.3.0") expect_match(out[["$schema"]], "dependency_graph\\.schema\\.json$") expect_true(validate_graph_json(tmp)$valid) }) @@ -270,18 +272,103 @@ test_that("migrate_dependency_graph_json upgrades an old-version graph file", { test_that("print.splitgraph_json_report shows issues only when invalid", { skip_if_no_jsonlite() g <- make_spec_graph() - good_path <- tempfile(fileext = ".json"); on.exit(unlink(good_path), add = TRUE) + good_path <- tempfile(fileext = ".json") + on.exit(unlink(good_path), add = TRUE) write_dependency_graph(g, good_path) valid_out <- capture.output(print(validate_graph_json(good_path))) expect_true(any(grepl("valid:.*TRUE", valid_out))) expect_false(any(grepl("issues:", valid_out))) - bad <- list(splitGraph_object = "split_spec", schema_version = "0.2.0", + bad <- list(splitGraph_object = "split_spec", schema_version = "0.3.0", group_var = "group_id", sample_data = list(list(sample_id = "S1"))) # missing group_id - bad_path <- tempfile(fileext = ".json"); on.exit(unlink(bad_path), add = TRUE) + bad_path <- tempfile(fileext = ".json") + on.exit(unlink(bad_path), add = TRUE) writeLines(jsonlite::toJSON(bad, auto_unbox = TRUE, null = "null"), bad_path) invalid_out <- capture.output(print(validate_split_spec_json(bad_path))) expect_true(any(grepl("valid:.*FALSE", invalid_out))) expect_true(any(grepl("issues:", invalid_out))) }) + +test_that("read_*(validate = TRUE) rejects non-conforming or invalid files with classed errors", { + skip_if_not_installed("jsonlite") + meta <- data.frame(sample_id = c("S1", "S2"), subject_id = c("P1", "P2"), batch_id = c("B1", "B1"), + stringsAsFactors = FALSE) + g <- graph_from_metadata(meta) + ok <- tempfile(fileext = ".json") + on.exit(unlink(ok), add = TRUE) + write_dependency_graph(g, ok) + expect_s3_class(read_dependency_graph(ok, validate = TRUE), "dependency_graph") + + # A schema violation (attrs as an array) is caught before parsing. + raw <- jsonlite::fromJSON(ok, simplifyVector = FALSE) + raw$nodes[[1]]$attrs <- list("not", "an", "object") + bad <- tempfile(fileext = ".json") + on.exit(unlink(bad), add = TRUE) + writeLines(jsonlite::toJSON(raw, auto_unbox = TRUE, null = "null", na = "null"), bad) + rep <- validate_graph_json(bad) + expect_false(rep$valid) + expect_true(any(grepl("attrs", rep$issues))) + expect_error(read_dependency_graph(bad, validate = TRUE), class = "splitgraph_schema_error") + # The lenient default skips the schema check, but the constructor still + # refuses malformed attrs; the error is then a generic splitgraph_error. + expect_error(read_dependency_graph(bad), class = "splitgraph_error") + + # A well-formed file whose graph fails validate_graph() (two batches per sample). + extra <- data.frame(sample_id = "S1", batch_id = "B2", stringsAsFactors = FALSE) + rows <- rbind(meta[, c("sample_id", "batch_id")], extra) + g_bad <- build_dependency_graph( + list(create_nodes(meta, "Sample", "sample_id"), create_nodes(rows, "Batch", "batch_id")), + list(create_edges(rows, "sample_id", "batch_id", "Sample", "Batch", "sample_processed_in_batch")), + validate = FALSE + ) + invalid <- tempfile(fileext = ".json") + on.exit(unlink(invalid), add = TRUE) + write_dependency_graph(g_bad, invalid) + expect_error(read_dependency_graph(invalid, validate = TRUE), class = "splitgraph_validation_error") + + # split_spec: a wrong column type is a schema violation; a missing group is a validation failure. + spec <- as_split_spec(derive_split_constraints(g, "subject"), graph = g) + sp <- tempfile(fileext = ".json") + on.exit(unlink(sp), add = TRUE) + write_split_spec(spec, sp) + expect_s3_class(read_split_spec(sp, validate = TRUE), "split_spec") + raw <- jsonlite::fromJSON(sp, simplifyVector = FALSE) + raw$sample_data[[1]]$time_index <- "not-a-number" + raw$metadata$relations_used <- "bare-string" + bad_sp <- tempfile(fileext = ".json") + on.exit(unlink(bad_sp), add = TRUE) + writeLines(jsonlite::toJSON(raw, auto_unbox = TRUE, null = "null", na = "null"), bad_sp) + rep <- validate_split_spec_json(bad_sp) + expect_false(rep$valid) + expect_true(any(grepl("time_index", rep$issues))) + expect_true(any(grepl("relations_used", rep$issues))) + expect_error(read_split_spec(bad_sp, validate = TRUE), class = "splitgraph_schema_error") +}) + +test_that("a 0.2.0 split_spec (no stratum) loads silently and migrates to 0.3.0", { + skip_if_not_installed("jsonlite") + meta <- data.frame(sample_id = c("S1", "S2"), subject_id = c("P1", "P2"), stringsAsFactors = FALSE) + g <- graph_from_metadata(meta) + spec <- as_split_spec(derive_split_constraints(g, "subject"), graph = g) + path <- tempfile(fileext = ".json") + on.exit(unlink(path), add = TRUE) + write_split_spec(spec, path) + raw <- jsonlite::fromJSON(path, simplifyVector = FALSE) + raw$schema_version <- "0.2.0" + raw$stratum_var <- NULL + raw$sample_data <- lapply(raw$sample_data, function(r) { + r$stratum <- NULL + r + }) + writeLines(jsonlite::toJSON(raw, auto_unbox = TRUE, null = "null", na = "null"), path) + + expect_silent(old <- read_split_spec(path)) + expect_true(all(is.na(old$sample_data$stratum))) + expect_null(old$stratum_var) + migrate_split_spec_json(path) + migrated <- jsonlite::fromJSON(path, simplifyVector = FALSE) + expect_identical(migrated$schema_version, "0.3.0") + expect_true(grepl("/0.3.0/", migrated[["$schema"]], fixed = TRUE)) + expect_true("stratum" %in% names(migrated$sample_data[[1]])) +}) diff --git a/tests/testthat/test-methods-coverage.R b/tests/testthat/test-methods-coverage.R new file mode 100644 index 0000000..2a46179 --- /dev/null +++ b/tests/testthat/test-methods-coverage.R @@ -0,0 +1,189 @@ +# Print / summary / as.data.frame methods and rarely reached validation +# branches. These exist mainly to keep the covr gate honest: every S3 method +# has to at least run and return its object, and every validation code the +# package documents has to be reachable by a test. + +cov_graph <- function() { + meta <- data.frame( + sample_id = c("S1", "S2", "S3", "S4"), + subject_id = c("P1", "P1", "P2", "P2"), + batch_id = c("B1", "B2", "B1", "B2"), + study_id = c("ST1", "ST1", "ST2", "ST2"), + timepoint_id = c("T1", "T2", "T1", "T2"), + time_index = c(1, 2, 1, 2), + outcome_id = c("a", "a", "b", "b"), + stringsAsFactors = FALSE + ) + graph_from_metadata(meta, graph_name = "cov") +} + +test_that("every S3 method prints, summarises, and converts", { + g <- cov_graph() + con <- derive_split_constraints(g, "time") + spec <- as_split_spec(con, graph = g) + report <- validate_graph(g) + preflight <- validate_split_spec(spec) + risks <- summarize_leakage_risks(g, constraint = con, split_spec = spec) + q <- query_node_type(g, "Sample") + + objects <- list(g$nodes, g$edges, g, q, con, report, spec, preflight, risks) + for (obj in objects) { + expect_output(print(obj)) + expect_identical(print(obj), obj) + s <- summary(obj) + expect_true(is.list(s)) + } + expect_s3_class(as.data.frame(g$nodes), "data.frame") + expect_s3_class(as.data.frame(g$edges), "data.frame") + expect_s3_class(as.data.frame(q), "data.frame") + expect_s3_class(as.data.frame(con), "data.frame") + expect_s3_class(as.data.frame(report), "data.frame") + expect_s3_class(as.data.frame(spec), "data.frame") + expect_s3_class(as.data.frame(preflight), "data.frame") + expect_s3_class(as.data.frame(risks), "data.frame") + + # summary details that carry information + expect_identical(summary(spec)$stratum_var, "stratum") # outcomes present -> stratum enriched from graph + expect_output(print(spec), "Stratum var: stratum") + expect_identical(summary(con)$mode, "time") + expect_true(all(c("n_nodes", "n_edges", "node_types", "edge_types") %in% names(summary(g)))) + expect_identical(summary(report)$n_issues, nrow(report$issues)) + expect_true("by_source" %in% names(summary(risks))) +}) + +test_that("print methods handle unnamed graphs, empty specs, and JSON reports", { + meta <- data.frame(sample_id = c("S1", "S2"), subject_id = c("P1", "P2"), stringsAsFactors = FALSE) + g <- graph_from_metadata(meta) + expect_output(print(g), "") + expect_output(print(split_spec()), "") + expect_output(print(validate_split_spec(split_spec())), "Valid") + expect_output(print(leakage_risk_summary()), "Diagnostics") + + skip_if_not_installed("jsonlite") + tmp <- tempfile(fileext = ".json") + on.exit(unlink(tmp), add = TRUE) + write_dependency_graph(g, tmp) + expect_output(print(validate_graph_json(tmp)), "valid: TRUE") + writeLines('{"splitGraph_object": "split_spec", "schema_version": "x"}', tmp) + expect_output(print(validate_split_spec_json(tmp)), "issues:") +}) + +test_that("plot variants render without error", { + g <- cov_graph() + pdf(NULL) + on.exit(dev.off(), add = TRUE) + expect_silent(plot(g, layout = "auto", legend = FALSE)) + expect_silent(plot(g, layout = igraph::layout_in_circle(as_igraph(g)))) + expect_silent(plot(g, layout = function(x) igraph::layout_with_fr(x))) + expect_silent(plot(g, node_colors = c(Sample = "red"), vertex.size = 5, legend_position = "bottomright")) +}) + +test_that("rare structural and semantic validation codes are reachable", { + # Hand-built tables reach codes the constructors normally prevent. + nodes <- data.frame( + node_id = c("sample:S1", "sample:S2", "timepoint:T1", "timepoint:T2", "featureset:F1", "outcome:O1", "assay:A1", "assay:A2"), + node_type = c("Sample", "Sample", "Timepoint", "Timepoint", "FeatureSet", "Outcome", "Assay", "Assay"), + node_key = c("S1", "S2", "T1", "T2", "F1", "O1", "A1", "A2"), + label = c("S1", "S2", "T1", "T2", "F1", "O1", "A1", "A2"), + attrs = I(list( + list(), list(), + list(time_index = "two"), list(time_index = 1), + list(derivation_scope = "everywhere"), + list(observation_level = "cohort"), + list(), list() + )), + stringsAsFactors = FALSE + ) + edges <- data.frame( + edge_id = c("e1", "e2", "e3", "e4", "e5", "e6", "e7"), + from = c("sample:S1", "sample:S1", "timepoint:T1", "timepoint:T1", "timepoint:T2", "sample:S1", "sample:S1"), + to = c("assay:A1", "assay:A2", "timepoint:T1", "timepoint:T2", "timepoint:T1", "featureset:F1", "outcome:O1"), + edge_type = c("sample_measured_by_assay", "sample_measured_by_assay", "timepoint_precedes", + "timepoint_precedes", "timepoint_precedes", "sample_uses_featureset", "sample_has_outcome"), + attrs = I(rep(list(list()), 7)), + stringsAsFactors = FALSE + ) + g <- dependency_graph(graph_node_set(nodes), graph_edge_set(edges), graph = NULL) + report <- validate_graph(g) + codes <- report$issues$code + expect_true("single_target_violation" %in% codes) # S1 measured by two assays + expect_true("timepoint_self_loop" %in% codes) # T1 -> T1 + expect_true("timepoint_precedence_cycle" %in% codes) # T1 -> T2 -> T1 + expect_true("invalid_time_index" %in% codes) # "two" + expect_true("invalid_featureset_derivation_scope" %in% codes) + expect_true("invalid_outcome_observation_level" %in% codes) + expect_false(report$valid) + + # Filtering by severity keeps validity based on all issues. + filtered <- validate_graph(g, severities = "advisory") + expect_false(filtered$valid) + expect_true(all(filtered$issues$severity == "advisory")) + expect_error(validate_graph(g, levels = "nonsense"), "unsupported") + expect_error(validate_graph(g, severities = "loud"), "unsupported") +}) + +test_that("unknown edge types and dangling endpoints are structural errors", { + nodes <- data.frame( + node_id = c("sample:S1", "subject:P1"), node_type = c("Sample", "Subject"), + node_key = c("S1", "P1"), label = c("S1", "P1"), attrs = I(list(list(), list())), + stringsAsFactors = FALSE + ) + edges <- data.frame( + edge_id = c("x1", "x2"), from = c("sample:S1", "sample:S1"), to = c("subject:P1", "subject:P1"), + edge_type = c("sample_is_friends_with", "sample_belongs_to_subject"), + attrs = I(list(list(), list())), stringsAsFactors = FALSE + ) + g <- dependency_graph(graph_node_set(nodes), graph_edge_set(edges), graph = NULL) + report <- validate_graph(g) + expect_true("unsupported_edge_type" %in% report$issues$code) + expect_false(report$valid) +}) + +test_that("time ordering falls back to precedence edges and reports partial coverage", { + meta <- data.frame( + sample_id = c("S1", "S2", "S3"), timepoint_id = c("T1", "T2", "T3"), stringsAsFactors = FALSE + ) + samples <- create_nodes(meta, "Sample", "sample_id") + tps <- create_nodes(meta, "Timepoint", "timepoint_id") + e1 <- create_edges(meta, "sample_id", "timepoint_id", "Sample", "Timepoint", "sample_collected_at_timepoint") + prec <- create_edges(data.frame(a = c("T1", "T2"), b = c("T2", "T3")), "a", "b", "Timepoint", "Timepoint", "timepoint_precedes") + g <- build_dependency_graph(list(samples, tps), list(e1, prec)) + con <- derive_split_constraints(g, "time") + expect_identical(con$metadata$time_order_source, "timepoint_precedes") + expect_identical(con$sample_map$order_rank, 1:3) + expect_true("timepoint_precedes" %in% con$metadata$relations_used) + + # No ordering information at all: warnings, NA ranks, ordering not required. + g2 <- build_dependency_graph(list(samples, tps), list(e1)) + con2 <- derive_split_constraints(g2, "time") + expect_true(all(is.na(con2$sample_map$order_rank))) + expect_false(con2$recommended_downstream_args$ordering_required) + expect_true(any(grepl("unavailable", con2$metadata$warnings))) + expect_identical(derive_split_constraints(g2, "time", include_warnings = FALSE)$metadata$warnings, character()) +}) + +test_that("query helpers cover edge filters, paths, and truncation flags", { + g <- cov_graph() + n_out <- query_neighbors(g, "sample:S1", direction = "out", node_types = "Subject") + expect_true(all(as.data.frame(n_out)$node_type == "Subject")) + n_in <- query_neighbors(g, "subject:P1", direction = "in") + expect_true(all(as.data.frame(n_in)$node_type == "Sample")) + n_all <- query_neighbors(g, "subject:P1", direction = "all", edge_types = "sample_belongs_to_subject") + expect_identical(nrow(as.data.frame(n_all)), 2L) + + e <- query_edge_type(g, "sample_processed_in_batch", node_ids = "sample:S1") + expect_identical(nrow(as.data.frame(e)), 1L) + + p <- query_paths(g, "sample:S1", "outcome:a", mode = "out", node_types = c("Sample", "Outcome")) + expect_true(nrow(as.data.frame(p)) >= 2L) + expect_false(p$metadata$truncated) + p_all <- query_paths(g, "sample:S1", "sample:S2", mode = "all", max_length = 2) + expect_true(is.logical(p_all$metadata$truncated)) + sp <- query_shortest_paths(g, "sample:S1", "sample:S2", mode = "all", node_types = c("Sample", "Subject")) + expect_identical(unique(as.data.frame(sp)$path_id), "path_1") + # igraph warns that S3 is unreachable in "out" mode; that is the case under test. + none <- suppressWarnings(query_shortest_paths(g, "sample:S1", "sample:S3", mode = "out")) + expect_identical(nrow(as.data.frame(none)), 0L) + expect_error(query_paths(g, "sample:S1", "sample:S2", max_length = -1), "non-negative") + expect_error(query_paths(g, "sample:S1", "sample:S2", max_length = "a"), "numeric") +}) diff --git a/tests/testthat/test-methods.R b/tests/testthat/test-methods.R index 8c6b105..103dc67 100644 --- a/tests/testthat/test-methods.R +++ b/tests/testthat/test-methods.R @@ -58,3 +58,15 @@ test_that("plot.dependency_graph renders with the typed layout", { expect_silent(plot(graph, layout = "sugiyama")) expect_silent(plot(graph, show_labels = FALSE)) }) + +test_that("plot focus modes render", { + meta <- data.frame(sample_id = c("S1", "S2", "S3"), subject_id = c("P1", "P1", "P2"), batch_id = c("B1", "B2", "B1"), + stringsAsFactors = FALSE) + g <- graph_from_metadata(meta) + pdf(NULL) + on.exit(dev.off(), add = TRUE) + expect_silent(plot(g, focus = "sample_projection", via = "Subject")) + expect_silent(plot(g, focus = "ego", node = "subject:P1")) + expect_error(plot(g, focus = "ego"), "node") + expect_error(plot(g, focus = "ego", node = "sample:nope"), class = "splitgraph_reference_error") +}) diff --git a/tests/testthat/test-performance.R b/tests/testthat/test-performance.R new file mode 100644 index 0000000..6972627 --- /dev/null +++ b/tests/testthat/test-performance.R @@ -0,0 +1,77 @@ +# Wall-clock budget guard for the core pipeline. This is not a benchmark: the +# budgets are deliberately generous (an order of magnitude above what the +# vectorised implementation needs on a laptop) so the test only fails when a +# change reintroduces per-row or per-pair construction, i.e. superlinear +# behaviour that would take minutes rather than seconds. Never runs on CRAN. + +perf_cohort <- function(n, seed = 7L) { + set.seed(seed) + meta <- data.frame( + sample_id = paste0("S", seq_len(n)), + subject_id = paste0("P", sample(ceiling(n / 3), n, replace = TRUE)), + batch_id = paste0("B", sample(ceiling(n / 50), n, replace = TRUE)), + study_id = paste0("ST", sample(5L, n, replace = TRUE)), + site_id = paste0("Site", sample(8L, n, replace = TRUE)), + timepoint_id = paste0("T", sample(4L, n, replace = TRUE)), + stringsAsFactors = FALSE + ) + meta$time_index <- as.integer(sub("T", "", meta$timepoint_id)) + meta +} + +elapsed <- function(expr) unname(system.time(expr)[["elapsed"]]) + +test_that("the core pipeline stays within its wall-clock budget at 5000 samples", { + skip_on_cran() + skip_if(identical(Sys.getenv("SPLITGRAPH_SKIP_PERF"), "true"), "perf budget disabled via SPLITGRAPH_SKIP_PERF") + + meta <- perf_cohort(5000L) + + t_build <- elapsed(g <- graph_from_metadata(meta, validate = FALSE)) + t_validate <- elapsed(report <- validate_graph(g)) + t_subject <- elapsed(con <- derive_split_constraints(g, "subject")) + # Default `via` includes study and timepoint targets shared by ~n/5 and ~n/4 + # samples: the case that used to be quadratic. + t_composite <- elapsed(comp <- derive_split_constraints(g, "composite")) + t_spec <- elapsed(spec <- as_split_spec(con, graph = g)) + tmp <- tempfile(fileext = ".json") + on.exit(unlink(tmp), add = TRUE) + t_write <- if (requireNamespace("jsonlite", quietly = TRUE)) elapsed(write_dependency_graph(g, tmp)) else 0 + + expect_s3_class(report, "depgraph_validation_report") + expect_identical(nrow(comp$sample_map), 5000L) + expect_identical(nrow(spec$sample_data), 5000L) + + budgets <- c(build = 10, validate = 10, subject = 5, composite = 15, spec = 15, write = 10) + timings <- c(build = t_build, validate = t_validate, subject = t_subject, + composite = t_composite, spec = t_spec, write = t_write) + over <- timings > budgets + expect_false( + any(over), + info = paste0( + "Steps over budget (seconds): ", + paste(sprintf("%s=%.1f (budget %.0f)", names(timings)[over], timings[over], budgets[over]), collapse = ", ") + ) + ) +}) + +test_that("composite derivation scales roughly linearly, not quadratically", { + skip_on_cran() + skip_if(identical(Sys.getenv("SPLITGRAPH_SKIP_PERF"), "true"), "perf budget disabled via SPLITGRAPH_SKIP_PERF") + + g_small <- graph_from_metadata(perf_cohort(1000L), validate = FALSE) + g_large <- graph_from_metadata(perf_cohort(4000L), validate = FALSE) + + # Warm up once so package loading and igraph initialisation are excluded. + invisible(derive_split_constraints(g_small, "composite")) + t_small <- elapsed(derive_split_constraints(g_small, "composite")) + t_large <- elapsed(derive_split_constraints(g_large, "composite")) + + # 4x the samples; quadratic behaviour would give ~16x. Allow up to 8x, and + # ignore the ratio entirely when both runs are too fast to measure reliably. + if (t_small >= 0.2) { + expect_lt(t_large / t_small, 8) + } else { + expect_lt(t_large, 3) + } +}) diff --git a/tests/testthat/test-python-conformance.R b/tests/testthat/test-python-conformance.R index 53c588d..88ccf95 100644 --- a/tests/testthat/test-python-conformance.R +++ b/tests/testthat/test-python-conformance.R @@ -6,7 +6,28 @@ skip_if_no_python_conformance <- function() { testthat::skip_if_not_installed("jsonlite") testthat::skip_on_cran() - py <- Sys.which("python3") + # Try `python3` first, then `python` (the usual name on Windows). A name on + # PATH is not proof of an interpreter: the Windows Store ships `python3.exe` + # / `python.exe` launcher stubs that print "Python not found" and exit + # non-zero. So probe each candidate by actually running it and keep the + # first one that reports a Python 3 major version. + py <- "" + for (name in c("python3", "python")) { + candidate <- Sys.which(name) + if (!nzchar(candidate)) next + probe <- tryCatch( + suppressWarnings(system2( + candidate, c("-c", shQuote("import sys; print(sys.version_info[0])")), + stdout = TRUE, stderr = TRUE + )), + error = function(e) character() + ) + ok <- is.null(attr(probe, "status")) && any(trimws(probe) == "3") + if (ok) { + py <- candidate + break + } + } if (!nzchar(py)) testthat::skip("python3 not available") script <- system.file("python", "conformance.py", package = "splitGraph") if (!nzchar(script) || !file.exists(script)) testthat::skip("conformance.py not found") @@ -21,6 +42,7 @@ test_that("Python reference consumer reproduces R grouping and order_rank", { subject_id = c("P1", "P1", "P2", "P3"), timepoint_id = c("T0", "T1", "T0", "T2"), time_index = c(0, 1, 0, 2), + outcome_id = c("case", "case", "ctrl", "ctrl"), stringsAsFactors = FALSE ) g <- graph_from_metadata(meta) @@ -58,4 +80,10 @@ test_that("Python reference consumer reproduces R grouping and order_rank", { py_order <- unlist(py$order_ranks) expect_equal(py_order[names(r_order)], r_order[names(r_order)], ignore_attr = TRUE) + + # Stratum annotation (schema 0.3.0) is recovered through stratum_var. + expect_identical(py$stratum_var, "stratum") + r_strata <- stats::setNames(spec$sample_data$stratum, spec$sample_data$sample_id) + py_strata <- unlist(py$strata) + expect_identical(py_strata[names(r_strata)], r_strata[names(r_strata)]) }) diff --git a/tests/testthat/test-schema-version.R b/tests/testthat/test-schema-version.R index f06f40a..736a3aa 100644 --- a/tests/testthat/test-schema-version.R +++ b/tests/testthat/test-schema-version.R @@ -2,7 +2,7 @@ test_that("schema_version is stable and independent of package version", { # The data-model schema version must NOT change automatically when the # package version is bumped. Only an explicit, documented schema change # should bump it. This test locks the contract. - expect_identical(splitGraph:::.depgraph_schema_version, "0.2.0") + expect_identical(splitGraph:::.depgraph_schema_version, "0.3.0") pkg_version <- as.character(utils::packageVersion("splitGraph")) expect_type(pkg_version, "character") diff --git a/tests/testthat/test-serialization.R b/tests/testthat/test-serialization.R index 2b5665c..f7294bd 100644 --- a/tests/testthat/test-serialization.R +++ b/tests/testthat/test-serialization.R @@ -33,13 +33,15 @@ test_that("write_dependency_graph + read_dependency_graph round-trip preserves s # Same nodes (sorted, comparing structural columns). n1 <- g$nodes$data[order(g$nodes$data$node_id), c("node_id", "node_type", "node_key", "label")] n2 <- g2$nodes$data[order(g2$nodes$data$node_id), c("node_id", "node_type", "node_key", "label")] - row.names(n1) <- NULL; row.names(n2) <- NULL + row.names(n1) <- NULL + row.names(n2) <- NULL expect_identical(n1, n2) # Same edges (sorted). e1 <- g$edges$data[order(g$edges$data$edge_id), c("edge_id", "from", "to", "edge_type")] e2 <- g2$edges$data[order(g2$edges$data$edge_id), c("edge_id", "from", "to", "edge_type")] - row.names(e1) <- NULL; row.names(e2) <- NULL + row.names(e1) <- NULL + row.names(e2) <- NULL expect_identical(e1, e2) # Validation status preserved (the rebuilt graph must validate). @@ -276,3 +278,32 @@ test_that("write_* / read_* error helpfully if jsonlite is missing", { # internal guard directly. expect_silent(splitGraph:::.depgraph_require_jsonlite()) }) + +test_that("vector metadata fields are always written as JSON arrays", { + skip_if_not_installed("jsonlite") + # A subject-mode spec has exactly one relation; with auto_unbox this used to + # serialize as a bare string, violating the schema (`relations_used` is an + # array) and making the JSON type depend on the vector length. + meta <- data.frame( + sample_id = c("S1", "S2"), + subject_id = c("P1", "P1"), + stringsAsFactors = FALSE + ) + g <- graph_from_metadata(meta) + spec <- as_split_spec(derive_split_constraints(g, mode = "subject"), graph = g) + expect_length(spec$metadata$relations_used, 1L) + + tmp <- tempfile(fileext = ".json") + on.exit(unlink(tmp), add = TRUE) + write_split_spec(spec, tmp) + raw <- jsonlite::fromJSON(tmp, simplifyVector = FALSE) + + expect_type(raw$metadata$relations_used, "list") + expect_identical(unlist(raw$metadata$relations_used), "sample_belongs_to_subject") + expect_type(raw$metadata$warnings, "list") + expect_type(raw$metadata$enrichment_warnings, "list") + + back <- read_split_spec(tmp) + expect_identical(back$metadata$relations_used, spec$metadata$relations_used) + expect_identical(back$metadata$warnings, character()) +}) diff --git a/tests/testthat/test-split-spec.R b/tests/testthat/test-split-spec.R index 911a899..e2680f7 100644 --- a/tests/testthat/test-split-spec.R +++ b/tests/testthat/test-split-spec.R @@ -262,3 +262,68 @@ test_that("summarize_leakage_risks reports a failing preflight and phantom block # The phantom block variable is reported as available for 0 samples. expect_true(any(grepl("phantom_group.*for 0 of", df$message))) }) + +test_that("as_split_spec enrichment tolerates ambiguous graph annotations", { + # A graph built with validate = FALSE can carry a sample linked to two + # batches. Enrichment must not abort a subject-mode translation because of + # an annotation it cannot resolve; it leaves the column NA and says why. + meta <- data.frame( + sample_id = c("S1", "S2"), + subject_id = c("P1", "P2"), + batch_id = c("B1", "B1"), + stringsAsFactors = FALSE + ) + extra <- data.frame(sample_id = "S1", batch_id = "B2", stringsAsFactors = FALSE) + batch_rows <- rbind(meta[, c("sample_id", "batch_id")], extra) + + g <- build_dependency_graph( + list( + create_nodes(meta, "Sample", "sample_id"), + create_nodes(meta, "Subject", "subject_id"), + create_nodes(batch_rows, "Batch", "batch_id") + ), + list( + create_edges(meta, "sample_id", "subject_id", "Sample", "Subject", "sample_belongs_to_subject"), + create_edges(batch_rows, "sample_id", "batch_id", "Sample", "Batch", "sample_processed_in_batch") + ), + validate = FALSE + ) + expect_false(validate_graph(g)$valid) + + constraint <- derive_split_constraints(g, mode = "subject") + spec <- as_split_spec(constraint, graph = g) + + expect_s3_class(spec, "split_spec") + expect_identical(spec$sample_data$group_id, c("subject:P1", "subject:P2")) + expect_true(all(is.na(spec$sample_data$batch_group))) + expect_false("batch_group" %in% spec$block_vars) + expect_length(spec$metadata$enrichment_warnings, 1L) + expect_match(spec$metadata$enrichment_warnings, "batch_group") + expect_match(spec$metadata$enrichment_warnings, "Multiple batch assignments") + expect_true(all(spec$metadata$enrichment_warnings %in% spec$metadata$warnings)) + expect_null(attr(spec$sample_data, "enrichment_warnings")) + expect_true(validate_split_spec(spec)$valid) + + skip_if_not_installed("jsonlite") + tmp <- tempfile(fileext = ".json") + on.exit(unlink(tmp), add = TRUE) + write_split_spec(spec, tmp) + back <- read_split_spec(tmp) + expect_identical(back$metadata$enrichment_warnings, spec$metadata$enrichment_warnings) +}) + +test_that("as_split_spec enrichment on a clean graph records no enrichment warnings", { + meta <- data.frame( + sample_id = c("S1", "S2", "S3"), + subject_id = c("P1", "P1", "P2"), + batch_id = c("B1", "B2", "B1"), + stringsAsFactors = FALSE + ) + g <- graph_from_metadata(meta) + spec <- as_split_spec(derive_split_constraints(g, mode = "subject"), graph = g) + + expect_identical(spec$sample_data$batch_group, c("B1", "B2", "B1")) + expect_identical(spec$block_vars, "batch_group") + expect_length(spec$metadata$enrichment_warnings, 0L) + expect_length(spec$metadata$warnings, 0L) +}) diff --git a/tests/testthat/test-summarized-experiment.R b/tests/testthat/test-summarized-experiment.R new file mode 100644 index 0000000..5e6c49e --- /dev/null +++ b/tests/testthat/test-summarized-experiment.R @@ -0,0 +1,39 @@ +test_that("graph_from_metadata dispatches on SummarizedExperiment colData", { + skip_if_not_installed("SummarizedExperiment") + meta <- data.frame( + sample_id = c("S1", "S2", "S3", "S4"), + subject_id = c("P1", "P1", "P2", "P2"), + batch_id = c("B1", "B2", "B1", "B2"), + stringsAsFactors = FALSE + ) + counts <- matrix(0, nrow = 5, ncol = 4, dimnames = list(paste0("g", 1:5), meta$sample_id)) + + # sample ids from the assay column names + se <- SummarizedExperiment::SummarizedExperiment( + assays = list(counts = counts), + colData = meta[, c("subject_id", "batch_id")] + ) + g_se <- graph_from_metadata(se, graph_name = "se") + g_df <- graph_from_metadata(meta, graph_name = "df") + expect_s3_class(g_se, "dependency_graph") + expect_identical( + grouping_vector(derive_split_constraints(g_se, "subject")), + grouping_vector(derive_split_constraints(g_df, "subject")) + ) + + # an explicit id column, renamed through `columns` + cd <- meta + names(cd) <- c("specimen", "donor", "run") + se2 <- SummarizedExperiment::SummarizedExperiment(assays = list(counts = counts), colData = cd) + g2 <- graph_from_metadata(se2, sample_id_col = "specimen", + columns = c(subject_id = "donor", batch_id = "run")) + expect_setequal(g2$nodes$data$node_key[g2$nodes$data$node_type == "Sample"], meta$sample_id) + expect_identical(sum(g2$nodes$data$node_type == "Batch"), 2L) + + expect_error(graph_from_metadata(se2, sample_id_col = "nope"), class = "splitgraph_reference_error") +}) + +test_that("graph_from_metadata rejects unsupported inputs with a schema error", { + expect_error(graph_from_metadata(list(a = 1)), class = "splitgraph_schema_error") + expect_error(graph_from_metadata(42), "must be a data.frame or a SummarizedExperiment") +}) diff --git a/tests/testthat/test-validate.R b/tests/testthat/test-validate.R index fa39648..e1d1e32 100644 --- a/tests/testthat/test-validate.R +++ b/tests/testthat/test-validate.R @@ -184,9 +184,8 @@ test_that("error_on_fail still errors when severity filtering hides visible erro fixed = TRUE ) expect_error( - suppressWarnings(validate_depgraph(graph, severities = "warning", error_on_fail = TRUE)), - "Graph validation failed.", - fixed = TRUE + validate_graph(graph, severities = "warning", error_on_fail = TRUE), + class = "splitgraph_validation_error" ) }) @@ -237,7 +236,7 @@ test_that("semantic validation does not require study assignments when no study expect_false(any(validation$issues$code == "sample_missing_study_assignment")) }) -test_that("validate_depgraph is a compatibility alias", { +test_that("validate_graph with all levels named explicitly matches the default", { nodes <- graph_node_set( data.frame( node_id = c("sample:S1", "sample:S2", "subject:P1", "featureset:FS1"), @@ -276,10 +275,7 @@ test_that("validate_depgraph is a compatibility alias", { ) graph <- dependency_graph(nodes = nodes, edges = edges, graph = NULL) - # validate_depgraph is deprecated as of 0.2.0; deprecation warnings are - # tested in test-deprecations.R, so silence them here while we verify - # delegation parity with validate_graph(). - validation <- suppressWarnings(validate_depgraph(graph)) + validation <- validate_graph(graph, levels = c("structural", "semantic", "leakage")) graph_validation <- validate_graph(graph) expect_s3_class(validation, "depgraph_validation_report") diff --git a/vignettes/.DS_Store b/vignettes/.DS_Store deleted file mode 100644 index 5008ddf..0000000 Binary files a/vignettes/.DS_Store and /dev/null differ diff --git a/vignettes/adapter-cookbook.Rmd b/vignettes/adapter-cookbook.Rmd index 81f9164..4216b95 100644 --- a/vignettes/adapter-cookbook.Rmd +++ b/vignettes/adapter-cookbook.Rmd @@ -34,18 +34,24 @@ if (requireNamespace("pkgload", quietly = TRUE) && `splitGraph` ends at a `split_spec` object. It deliberately knows nothing about `rsample`, `tidymodels`, or any other resampling engine. The handoff contract is the `sample_data` table inside the spec plus a few scalar -fields (`group_var`, `block_vars`, `time_var`, `ordering_required`, -`recommended_resampling`), together with provenance the adapter can inspect -to choose a strategy (`constraint_mode`, `constraint_strategy`). +fields (`group_var`, `block_vars`, `time_var`, `stratum_var`, +`ordering_required`, `recommended_resampling`), together with provenance the +adapter can inspect to choose a strategy (`constraint_mode`, +`constraint_strategy`). You do not always have to write this glue yourself. The reference downstream consumer, [**bioLeak**](https://github.com/selcukorkmaz/bioLeak), takes a `split_spec` directly — `bioLeak::as_leaksplits(spec, data, outcome)` builds an -executable, leakage-audited split plan from it. This cookbook is for the other -case: when you want to feed a `split_spec` into a different engine, or -understand exactly what a consumer has to honor. It shows three small, -self-contained adapters that turn a `split_spec` into something a downstream -workflow can use: +executable, leakage-audited split plan from it. The released bioLeak (0.3.8) +reads the `subject`, `batch`, `study` and `time` modes; for the others, +including `composite`, hand it the grouping column instead +(`bioLeak::make_split_plan(joined, outcome, mode = "subject_grouped", +group = "group_id")`), which produces the same split by a different route. + +This cookbook is for the other case: when you want to feed a `split_spec` into a +different engine, or understand exactly what a consumer has to honor. It shows +three small, self-contained adapters that turn a `split_spec` into something a +downstream workflow can use: 1. A **base-R adapter** that returns a list of `(train, test)` row-index pairs — runnable here, no extra dependencies. @@ -54,9 +60,9 @@ workflow can use: 3. An **`rsample::rolling_origin()`** adapter for ordered evaluation keyed to `order_rank`. -Adapters 2 and 3 show idiomatic glue but are not evaluated in this -vignette so that `splitGraph` does not pick up `rsample` as a build-time -dependency. +Adapters 2 and 3 are evaluated when `rsample` is installed (it is in +`Suggests`, never in `Imports`: `splitGraph` itself has no resampling +dependency) and shown as code otherwise. The same pattern works for any other resampling library you happen to use. @@ -116,6 +122,7 @@ logo_folds <- function(spec, observation_data, sample_id_col = "sample_id") { } # Pretend we have an observation frame keyed by sample_id. +set.seed(1) obs <- data.frame( sample_id = meta$sample_id, x = rnorm(nrow(meta)), @@ -168,13 +175,53 @@ Every batch appears on both sides, because grouping by subject does not also block by batch. Whether that matters is a scientific decision — the point is that the spec carries enough information for the adapter to make it. +### Honoring the stratum annotation + +`stratum_var` names one more column: the outcome level each sample carries. +`splitGraph` records it and stops there — it never balances folds itself — so +stratification is the adapter's job, and the spec hands it the input. + +```{r stratum} +spec$stratum_var +spec$sample_data[, c("sample_id", spec$group_var, spec$stratum_var)] +``` + +There is a catch worth knowing before you wire it into a resampler's `strata` +argument. The annotation is *per sample*, while the split unit is the group, and +the two need not agree: here every subject contributes one `case` and one +`ctrl`, so no group has a single stratum at all. + +```{r stratum-constant} +tapply(spec$sample_data$stratum, spec$sample_data$group_id, + function(x) length(unique(x)) == 1L) +``` + +A grouped resampler that stratifies needs one stratum per *group*, and says so +plainly when it does not get one: + +```{r stratum-rsample, eval = requireNamespace("rsample", quietly = TRUE)} +joined_s <- merge(obs, spec$sample_data[, c("sample_id", "group_id", "stratum")], + by = "sample_id", sort = FALSE) + +tryCatch( + rsample::group_vfold_cv(joined_s, group = "group_id", v = 3, strata = "stratum"), + error = function(e) conditionMessage(e) +) +``` + +So the adapter has to decide how to get there — summarise the annotation to the +group level (the group's only label when it has one, a majority label otherwise), +stratify on a blocking variable that *is* constant within the group, or accept +unbalanced folds. `splitGraph` deliberately does not pick for you; it records +what each sample is so the choice is visible instead of silent. + ## Adapter 2 — `rsample::group_vfold_cv()` Grouped CV keyed to `group_id`. The downstream package would typically ship something like this; the adapter is short enough that you can paste it into your own analysis script. -```{r adapter-rsample-group, eval=FALSE} +```{r adapter-rsample-group, eval = requireNamespace("rsample", quietly = TRUE)} spec_to_group_vfold <- function(spec, observation_data, v = NULL, sample_id_col = "sample_id") { @@ -205,12 +252,21 @@ right default when `splitGraph` has already grouped samples by their deepest leakage-relevant unit (e.g. subject). Pick a smaller `v` for k-fold-style grouped CV. +```{r adapter-rsample-group-run, eval = requireNamespace("rsample", quietly = TRUE)} +grouped <- spec_to_group_vfold(spec, obs) +grouped +# Every assessment set is exactly one subject's samples: +vapply(grouped$splits, function(s) { + paste(sort(unique(rsample::assessment(s)$group_id)), collapse = ", ") +}, character(1)) +``` + ## Adapter 3 — `rsample::rolling_origin()` When `spec$ordering_required` is `TRUE` (or `spec$time_var` is set), the right downstream object is an ordered split rather than a grouped one. -```{r adapter-rsample-rolling, eval=FALSE} +```{r adapter-rsample-rolling, eval = requireNamespace("rsample", quietly = TRUE)} spec_to_rolling_origin <- function(spec, observation_data, sample_id_col = "sample_id", initial = NULL, @@ -235,14 +291,74 @@ spec_to_rolling_origin <- function(spec, observation_data, } ``` +```{r adapter-rsample-rolling-run, eval = requireNamespace("rsample", quietly = TRUE)} +rolling <- spec_to_rolling_origin(spec, obs, initial = 3, assess = 1) +rolling +# No analysis sample comes after any assessment sample: +vapply(rolling$splits, function(s) { + max(rsample::analysis(s)$order_rank) <= min(rsample::assessment(s)$order_rank) +}, logical(1)) +``` + The key idea: `splitGraph` puts ordering information on the spec; the adapter is just a thin shim that consumes it. +### Two things to check before trusting an ordered adapter + +**`order_rank` has ties, and row-wise slicing ignores them.** `order_rank` is a +rank over *timepoints*, not over rows, so every sample collected at the same +timepoint shares a value — here six samples carry just two distinct ranks. A +resampler that slices by row position will therefore put part of a timepoint in +the analysis set and the rest in the assessment set: + +```{r rolling-ties, eval = requireNamespace("rsample", quietly = TRUE)} +length(unique(spec$sample_data$order_rank)) # distinct ranks +nrow(spec$sample_data) # rows + +vapply(rolling$splits, function(s) { + shared <- intersect(rsample::analysis(s)$order_rank, + rsample::assessment(s)$order_rank) + paste(shared, collapse = ", ") +}, character(1)) +``` + +Slices 2 and 3 share rank `2`: one `T1` sample is being predicted while another +`T1` sample is in training. If your evaluation requires that a whole timepoint +be held out, cut on rank boundaries rather than row counts — choose `initial` so +it falls at a change of `order_rank`, or group the rows by rank first. The spec +gives you the rank; only you know whether ties are acceptable. + +**`rolling_origin()` is superseded.** It still works and is not deprecated, but +rsample now steers users to `sliding_window()` / `sliding_index()` / +`sliding_period()`, where active development happens. The equivalent call is: + +```{r sliding-window, eval = requireNamespace("rsample", quietly = TRUE)} +joined <- merge(obs, spec$sample_data[, c("sample_id", spec$time_var)], + by = "sample_id", sort = FALSE) +ordered <- joined[order(joined[[spec$time_var]]), , drop = FALSE] + +sliding <- rsample::sliding_window( + ordered, + lookback = Inf, # cumulative analysis window, like rolling_origin() + assess_stop = 1, + complete = FALSE, + skip = 2 # start where `initial = 3` did +) + +identical( + lapply(sliding$splits, function(s) rsample::assessment(s)$sample_id), + lapply(rolling$splits, function(s) rsample::assessment(s)$sample_id) +) +``` + +Either way the adapter is the same shim; only the rsample entry point changes. + ## Going across language boundaries via JSON If the downstream consumer is not in R, write the spec to JSON and let the consumer interpret it. The on-disk format is a formal, versioned contract: it -has a JSON Schema (Draft 2020-12) shipped in `inst/schema/`, each file names it +has a JSON Schema (Draft 2020-12) shipped in `inst/schema//`, +each file names it via a `$schema` key, and `validate_split_spec_json()` checks a file against it before you consume it. @@ -304,9 +420,51 @@ time_spec <- as_split_spec(derive_split_constraints(g, mode = "time"), graph = g recommend_adapter(time_spec) ``` -`recommended_resampling` is only a hint — your adapter is free to override it — -but it lets one entry point serve every constraint mode without inspecting the -graph. +Those five branches are the whole vocabulary: `recommended_resampling` takes one +of exactly `grouped_cv`, `blocked_cv`, `leave_one_group_out`, `ordered_split` and +`custom_grouped_cv`, whatever the mode. Eleven modes map onto them like this: + +| `recommended_resampling` | Modes that produce it | +|---|---| +| `grouped_cv` | `subject`, `region`, `assay`, `relatedness`, `spatial`, `composite` (rule-based) | +| `blocked_cv` | `batch`, `platform` | +| `leave_one_group_out` | `study`, `site` | +| `ordered_split` | `time` | +| `custom_grouped_cv` | `composite` (strict) | + +```{r dispatch-exhaustive} +# One graph carrying every direct relation, so each mode has something to group. +g_all <- graph_from_metadata(transform( + meta, + site_id = c("N", "N", "N", "B", "B", "B"), + region_id = "ctx", + platform_id = "il", + assay_id = "rna" +)) + +modes <- c("subject", "batch", "study", "time", + "site", "region", "platform", "assay") +vapply(modes, function(m) { + as_split_spec(derive_split_constraints(g_all, mode = m), + graph = g_all)$recommended_resampling +}, character(1)) + +# And the two composite strategies, which supply the fifth value. +c( + strict = as_split_spec(derive_split_constraints( + g_all, mode = "composite", strategy = "strict", + via = c("Subject", "Batch")), graph = g_all)$recommended_resampling, + rule_based = as_split_spec(derive_split_constraints( + g_all, mode = "composite", strategy = "rule_based", + priority = c("subject", "batch")), graph = g_all)$recommended_resampling +) +``` + +So a dispatcher with those five branches cannot be surprised by a spec, and the +`default` arm above is belt and braces rather than a real fallback. +`recommended_resampling` is still only a hint — your adapter is free to override +it — but it lets one entry point serve every constraint mode without inspecting +the graph. ## When you need a custom adapter @@ -318,10 +476,15 @@ The only assumptions an adapter has to honor: the graph these include `batch_group`, `study_group`, `site_group`, `region_group`, `platform_group`, and `assay_group` — an adapter can block or stratify on any that are present. -- `split_spec$time_var`, when non-`NULL`, defines the ordering. +- `split_spec$time_var`, when non-`NULL`, defines the ordering. Its values are + ranks over timepoints, so ties are expected and meaningful. +- `split_spec$stratum_var`, when non-`NULL`, names the per-sample outcome level. + It is an annotation: `splitGraph` never balances folds, and the value is not + guaranteed constant within a group. - `split_spec$recommended_resampling` is a hint, not a contract — your - adapter is free to ignore it. `constraint_mode` / `constraint_strategy` are - available if you want to branch (e.g. treat `"time"` specs as ordered). + adapter is free to ignore it. It is one of five documented strings. + `constraint_mode` / `constraint_strategy` are available if you want to branch + (e.g. treat `"time"` specs as ordered). That is the whole interface, and it is stable: `bioLeak::as_leaksplits()` consumes exactly these fields, and a contract test in splitGraph pins the seam diff --git a/vignettes/case-study-gse60424.Rmd b/vignettes/case-study-gse60424.Rmd new file mode 100644 index 0000000..c4f21f1 --- /dev/null +++ b/vignettes/case-study-gse60424.Rmd @@ -0,0 +1,264 @@ +--- +title: "Case study: a real multi-donor, multi-cell-type cohort (GEO GSE60424)" +output: + rmarkdown::html_vignette: + toc: true +vignette: > + %\VignetteIndexEntry{Case study: a real multi-donor, multi-cell-type cohort (GEO GSE60424)} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r setup, include = FALSE} +knitr::opts_chunk$set(collapse = TRUE, comment = "#>") +library(splitGraph) +``` + +The other vignettes use small synthetic tables. This one walks through a real +public cohort whose metadata has exactly the kind of structure that makes naive +random splits leak, and shows what splitGraph's validation, derivation, and +`split_spec` look like on it. + +## The data + +GEO series [GSE60424](https://www.ncbi.nlm.nih.gov/geo/query/acc.cgi?acc=GSE60424) +is an RNA-seq study of whole blood and six sorted immune cell populations from +20 donors: healthy controls and patients with type 1 diabetes, amyotrophic +lateral sclerosis, sepsis, or multiple sclerosis. The sample-level metadata +(not the expression data) ships with splitGraph as +`inst/extdata/GSE60424_samples.csv`; `inst/extdata/GSE60424_README.md` records +how it was derived from the GEO `characteristics` fields. + +```{r load} +path <- system.file("extdata", "GSE60424_samples.csv", package = "splitGraph") +gse <- read.csv(path, stringsAsFactors = FALSE) +str(gse) +``` + +Three facts about its structure drive everything below: + +```{r facts} +# 1. Every donor contributed six or seven samples, one per cell population +# that was successfully sorted for them. +range(table(gse$subject_id)) +table(table(gse$subject_id)) +# 2. Every donor was collected on its own date, so collection date (the natural +# "batch") coincides with donor. +all(tapply(gse$batch_id, gse$subject_id, function(x) length(unique(x))) == 1) +# 3. Every donor has exactly one disease status. +all(tapply(gse$condition, gse$subject_id, function(x) length(unique(x))) == 1) +``` + +One caveat about the labels: GEO records multiple sclerosis samples as +"pretreatment" or "posttreatment", but these come from *different* donors +(three each), not from the same individuals over time. There is therefore no +repeated-measure time axis in this cohort, and we deliberately do **not** model +the labels as timepoints; they stay inside `disease_status`. + +```{r no-longitudinal} +with(gse[gse$condition == "MS", ], table(subject_id, timepoint_id)) +``` + +## Build the graph + +Sorted cell populations are a categorical compartment of the sample, which is +what splitGraph's `Region` node type represents; disease status is the outcome. +`columns =` maps the CSV names onto the canonical ones. + +```{r build} +meta <- gse[, c("sample_id", "subject_id", "batch_id", "cell_type", "condition", "sex")] +g <- graph_from_metadata( + meta, + columns = c(region_id = "cell_type", outcome_id = "condition"), + graph_name = "GSE60424" +) +g +summary(g)$node_types +``` + +At 186 nodes this is past the size where drawing the whole graph tells you +anything. `focus = "ego"` is the view for a graph like this: it zooms to one +node's neighbourhood, so you can check a single donor's structure instead of +squinting at the cohort. Two hops out from donor `D20` reach its samples, and +through them the cell populations, collection date and disease status those +samples carry: + +```{r ego, fig.width = 7.2, fig.height = 5, dpi = 150, out.width = "100%"} +plot(g, focus = "ego", node = "subject:D20", order = 2, + legend_position = "bottomleft") +``` + +## What validation says + +```{r validate} +report <- validate_graph(g) +report +summary(report)$by_code +``` + +Twenty `repeated_subject_samples` advisories, one per donor: every donor is +linked to several samples, so any split that treats samples as independent will +put the same person on both sides. Nothing rises above advisory, and the report +is short for two different reasons worth separating. + +The cross-study and cross-site rules cannot fire because this graph has no +`Study` or `Site` nodes at all — the CSV carries neither, so those axes simply do +not exist here. `heavy_batch_reuse` does not fire because no batch holds half +the cohort: each collection date covers one donor's six or seven samples. + +There is also no rule for a donor spanning several *regions*, and in this cohort +every donor spans six or seven of them. That is deliberate rather than an +oversight: one person contributing several sorted cell populations is the design +of the experiment, not an anomaly. The advisory that a donor has several samples +already carries the leakage signal; which compartments those samples came from +is information for the split, not a finding against the data. + +## How much would a naive split leak? + +A plain random five-fold assignment of the 134 samples, without splitGraph: + +```{r naive} +set.seed(1) +fold <- sample(rep(1:5, length.out = nrow(gse))) +straddling <- tapply(fold, gse$subject_id, function(f) length(unique(f)) > 1) +sum(straddling) +``` + +`r sum(straddling)` of 20 donors would appear in more than one fold. A model +evaluated that way sees each test donor's other cell populations during +training. + +## Derive constraints + +```{r derive} +by_subject <- derive_split_constraints(g, mode = "subject") +by_batch <- derive_split_constraints(g, mode = "batch") +by_region <- derive_split_constraints(g, mode = "region") +c(subject = by_subject$metadata$n_groups, + batch = by_batch$metadata$n_groups, + region = by_region$metadata$n_groups) +``` + +Because collection date and donor coincide, the batch partition *is* the +subject partition. Two groupings with different labels but the same partition +compare equal under a canonical relabelling: + +```{r same-partition} +canon <- function(x) as.integer(match(x, unique(x))) +identical(canon(grouping_vector(by_subject)), canon(grouping_vector(by_batch))) +``` + +The region partition is a different animal, and it is worth seeing why it is the +wrong split unit here even though it is a perfectly valid one. Grouping by cell +population cuts the cohort *across* donors rather than between them, so every +donor lands in six or seven different groups — the exact leak the study is +exposed to: + +```{r region-wrong} +region_groups <- grouping_vector(by_region) +donor_spread <- tapply(region_groups[gse$sample_id], gse$subject_id, + function(x) length(unique(x))) +range(donor_spread) +sum(donor_spread > 1) # donors split across more than one region group +``` + +Which is why region travels on the spec as a blocking annotation below, not as +`group_var`. The same column can be the right answer or the wrong one depending +on what has to generalise; the graph makes the difference inspectable rather +than a matter of taste. + +### Composite grouping and over-merging + +Six of the seven cell populations were sorted for all twenty donors. That is +enough for a strict composite over subject **and** region to chain the entire +cohort into one component — donor A's B-cells link to every other donor's +B-cells, which link to their own other populations, and so on until nothing is +left to split. + +```{r composite} +strict <- derive_split_constraints(g, mode = "composite", via = c("subject", "region")) +strict$metadata$n_groups +strict$metadata$warnings +``` + +The empty warning vector is the part to notice. One group covering all 134 +samples is a correct answer to the question that was asked, and `splitGraph` +does not flag it, so on a composite derivation read `metadata$n_groups` yourself +before going further. `detect_dependency_components()` shows it coming before +you derive anything: + +```{r components} +comps <- detect_dependency_components(g, via = c("Subject", "Region")) +table(as.data.frame(comps)$component_size) +``` + +A single component of 134 — the cohort has no internal boundary along those two +relations together. + +The rule-based strategy does not chain relations. With subject first in the +priority order, every sample has a subject, so region is never consulted and +the grouping is the subject partition, with region kept as an annotation: + +```{r rule-based} +ruled <- derive_split_constraints( + g, mode = "composite", strategy = "rule_based", + via = c("subject", "region"), priority = c("subject", "region") +) +ruled$metadata$n_groups +head(as.data.frame(ruled)[, c("sample_id", "group_id", "constraint_type")], 3) +``` + +## The split_spec + +Grouping by subject is the right primary constraint here; batch and region +travel as blocking annotations and the disease status as the stratum. + +```{r spec} +spec <- as_split_spec(by_subject, graph = g) +spec +spec$block_vars +spec$stratum_var +head(as.data.frame(spec)[, c("sample_id", "group_id", "batch_group", "region_group", "stratum")], 7) +validate_split_spec(spec) +``` + +The leakage summary marks which of the validation findings this constraint +structurally severs: + +```{r risks} +risks <- summarize_leakage_risks(g, constraint = by_subject, split_spec = spec) +unique(as.data.frame(risks)[, c("category", "severity", "severed")]) +``` + +A consumer that groups on `group_id` and stratifies on `stratum` (for example +scikit-learn's `StratifiedGroupKFold` through the shipped Python reader, or +bioLeak's `as_leaksplits()`) will now keep every donor's cell populations on +one side of each fold while keeping the five conditions represented in every +fold as far as 20 donors allow. + +## Working with a subset + +Restricting the analysis to, say, healthy controls and multiple sclerosis +patients is a graph operation, not a re-import: + +```{r subset} +keep <- gse$sample_id[gse$condition %in% c("Healthy Control", "MS")] +g_sub <- subset_graph(g, samples = keep, graph_name = "GSE60424: HC vs MS") +summary(g_sub)$node_types +spec_sub <- as_split_spec(derive_split_constraints(g_sub, "subject"), graph = g_sub) +table(spec_sub$sample_data$stratum) +``` + +## Handing off + +```{r write, eval = requireNamespace("jsonlite", quietly = TRUE)} +out <- tempfile(fileext = ".json") +write_split_spec(spec, out) +validate_split_spec_json(out)$valid +unlink(out) +``` + +The JSON carries the grouping, the blocking columns, the stratum, and the +provenance (`metadata$relations_used`, `splitgraph_version`, `derived_at`), so +the decision "one donor never straddles a fold" is recorded once and can be +executed anywhere. diff --git a/vignettes/cross-language-handoff.Rmd b/vignettes/cross-language-handoff.Rmd index 877469a..2b97ac9 100644 --- a/vignettes/cross-language-handoff.Rmd +++ b/vignettes/cross-language-handoff.Rmd @@ -28,9 +28,10 @@ scikit-learn resampler. The Python chunks below are shown but not executed, so building the vignette needs no Python. To keep the central claim honest rather than asserted, the -vignette *does* run the shipped Python reader through R when a `python3` -interpreter is available (see "Verify the round-trip"), and shows that the -grouping it recovers matches R's exactly. +vignette *does* run the shipped Python reader through R whenever a working +Python 3 is on the `PATH` (see "Verify the round-trip"), and shows that the +grouping, ordering and stratum it recovers match R's exactly. Where no +interpreter is found it says so rather than quietly printing nothing. # Derive and serialize in R @@ -42,6 +43,7 @@ meta <- data.frame( subject_id = c("P1", "P1", "P2", "P3", "P3"), timepoint_id = c("T0", "T1", "T0", "T2", "T0"), time_index = c(0, 1, 0, 2, 0), + outcome_id = c("case", "case", "ctrl", "ctrl", "ctrl"), stringsAsFactors = FALSE ) @@ -64,8 +66,34 @@ report$valid # The R-side grouping we expect Python to reproduce: grouping_vector(constraint) + +# The outcome travels with the spec as a stratum annotation, so a consumer can +# stratify without touching the graph. splitGraph never balances folds itself. +spec$stratum_var +spec$sample_data$stratum +``` + +# What is actually on disk + +Before leaving R it is worth looking at the artifact itself, because that file +— not any R or Python object — is the contract. It is a single JSON object with +a small, flat shape: scalar declarations at the top, then one row per sample. + +```{r json-shape, eval = requireNamespace("jsonlite", quietly = TRUE)} +on_disk <- jsonlite::fromJSON(path, simplifyVector = FALSE) +names(on_disk) + +# One sample row. Every declared role above names a column in here. +str(on_disk$sample_data[[1]]) ``` +The top-level fields say how to read the rows: `group_var` names the grouping +column, `stratum_var` the stratum, `time_var` the ordering, `block_vars` the +blocking columns. A consumer keys on those names rather than hard-coding +`group_id`, which is what lets the same file drive tools that have never heard +of each other. Columns that do not apply to this cohort are `null`, not absent, +so the row shape is the same for every sample. + # Read in Python The reference consumer lives in the installed package under `inst/python`. On @@ -75,7 +103,17 @@ the R side its location is: system.file("python", package = "splitGraph") ``` -Point Python at that directory (or install/copy the `splitspec` package), then: +That directory is a complete, installable package — `pip install` it, or just +put it on `sys.path`: + +```bash +pip install "" # reader only +pip install "[sklearn]" # + sklearn helpers +``` + +The reader itself imports nothing outside the standard library; `to_frame()` +pulls in pandas and the resampler helpers import scikit-learn, both lazily, so a +consumer that only needs the grouping pays for neither. Then: ```python import sys @@ -84,9 +122,11 @@ from splitspec import load_split_spec spec = load_split_spec("split_spec.json") -spec.schema_version # "0.2.0" +spec.schema_version # "0.3.0" spec.constraint_mode # "subject" spec.recommended_resampling # "grouped_cv" +spec.stratum_var # "stratum" +spec.strata() # ['case', 'case', 'ctrl', 'ctrl', 'ctrl'] # Grouping keyed by sample_id — identical to R's grouping_vector(): spec.grouping() @@ -96,41 +136,124 @@ spec.grouping() df = spec.to_frame() # pandas DataFrame of sample_data ``` +That is not the whole surface. The reader mirrors every top-level field of the +file and adds the accessors a resampler needs: + +| Attribute | From the file | +|---|---| +| `schema_version`, `constraint_mode`, `constraint_strategy` | provenance of the partition | +| `group_var`, `stratum_var`, `time_var`, `block_vars` | which column plays which role | +| `ordering_required` | whether the consumer *must* respect the ordering | +| `recommended_resampling` | the routine R suggests, as a plain string | +| `metadata` | the free-form block, including any `warnings` R recorded | +| `sample_data`, `sample_ids` | the rows, in file order | + +| Method | Returns | +|---|---| +| `groups()` | `group_var` per sample, in file order | +| `strata(column=None)` | stratum per sample; any other column on request | +| `order_ranks()` | `order_rank` per sample, `None` where undetermined | +| `ordered_index()` | row indices sorted by `order_rank`, missing ranks last | +| `grouping()` | `{sample_id: group_id}` — the analogue of `grouping_vector()` | +| `to_frame()` | `sample_data` as a pandas DataFrame | +| `group_kfold()`, `stratified_group_kfold()` | scikit-learn splitters, wired up | + +Everything above `to_frame()` is standard library only. + +## Versions are part of the contract + +The reader checks `schema_version` and accepts any file whose **major** version +it understands — currently major `0`, matching the R side's policy. A minor bump +only ever adds fields, so an older file loads silently with the new fields +absent: a spec written before schema 0.3.0 has no stratum, and there +`spec.stratum_var` is `None` rather than an error. A future major would be +refused outright with a `ValueError` naming the version, instead of being +misread. + +Going the other way, `migrate_split_spec_json()` on the R side rewrites an old +file at the current version, filling anything added since with `null`. So a +consumer has two options for an aged archive and neither of them is guessing. + # Verify the round-trip Rather than take the comment above on faith, we can run the shipped Python reader on the exact file we just wrote and compare what it recovers to R's `grouping_vector()`. This is what `inst/python/conformance.py` does; the chunk -below invokes it through R and only runs when a `python3` interpreter is -present, so the vignette still builds without Python. - -```{r conformance, eval = nzchar(Sys.which("python3")) && requireNamespace("jsonlite", quietly = TRUE)} -script <- system.file("python", "conformance.py", package = "splitGraph") -out_path <- tempfile(fileext = ".json") - -# Run the Python reader on our JSON file; it writes back what it recovered. -status <- system2( - "python3", c("-B", shQuote(script), shQuote(path), shQuote(out_path)), - stdout = FALSE, stderr = FALSE -) - -if (status == 0 && file.exists(out_path)) { - recovered <- jsonlite::fromJSON(out_path) +below invokes it through R, so the vignette still builds without Python but +says which of the two happened rather than falling silent. + +Finding the interpreter takes a little care. A name on the `PATH` is not proof +of a Python: Windows ships `python3.exe` and `python.exe` launcher stubs that +print "Python not found" and exit non-zero, so `Sys.which("python3")` can +succeed where actually running it does not. The helper below probes each +candidate by executing it and keeps the first that reports a Python 3 — the +same rule the package's own conformance test uses. + +```{r find-python} +find_python <- function() { + for (name in c("python3", "python")) { + candidate <- Sys.which(name) + if (!nzchar(candidate)) next + probe <- tryCatch( + suppressWarnings(system2( + candidate, c("-c", shQuote("import sys; print(sys.version_info[0])")), + stdout = TRUE, stderr = TRUE + )), + error = function(e) character() + ) + if (is.null(attr(probe, "status")) && any(trimws(probe) == "3")) return(candidate) + } + "" +} - # Grouping recovered by Python: - print(unlist(recovered$grouping)) +python <- find_python() +nzchar(python) +``` - # Identical to the grouping R produced? - r_grouping <- grouping_vector(constraint) - cat("Python matches R exactly:", - identical(unlist(recovered$grouping)[names(r_grouping)], - r_grouping[names(r_grouping)]), "\n") +```{r conformance, eval = requireNamespace("jsonlite", quietly = TRUE)} +if (!nzchar(python)) { + cat("No usable Python 3 found; skipping the round-trip check.\n") +} else { + script <- system.file("python", "conformance.py", package = "splitGraph") + out_path <- tempfile(fileext = ".json") + + # Run the Python reader on our JSON file; it writes back what it recovered. + status <- suppressWarnings(system2( + python, c("-B", shQuote(script), shQuote(path), shQuote(out_path)), + stdout = FALSE, stderr = FALSE + )) + + if (!identical(status, 0L) || !file.exists(out_path)) { + cat("The Python reader could not be run (exit status ", status, ").\n", sep = "") + } else { + recovered <- jsonlite::fromJSON(out_path) + r_grouping <- grouping_vector(constraint) + ids <- spec$sample_data$sample_id + + # Grouping recovered by Python: + print(unlist(recovered$grouping)) + + # Identical to the grouping R produced? + cat("grouping matches:", + identical(unlist(recovered$grouping)[names(r_grouping)], + r_grouping[names(r_grouping)]), "\n") + + # The script returns the ordering and the stratum annotation too. + cat("order_rank matches:", + identical(as.integer(unlist(recovered$order_ranks)[ids]), + as.integer(spec$sample_data$order_rank)), "\n") + cat("stratum matches:", + identical(unname(unlist(recovered$strata)[ids]), + spec$sample_data$stratum), "\n") + unlink(out_path) + } } ``` -The same script also checks `order_rank`, and the package's test suite runs this -comparison as an automated conformance test (skipped when Python is absent, and -never on CRAN). The point is that the partition is *decided once* in R and only +The package's test suite runs exactly this comparison as an automated +conformance test (`test-python-conformance.R`, skipped when Python is absent and +never on CRAN), so the two implementations cannot drift apart unnoticed between +releases. The point is that the partition is *decided once* in R and only *reproduced* elsewhere — the two languages cannot disagree. # Drive scikit-learn @@ -150,8 +273,36 @@ for train_idx, test_idx in GroupKFold(n_splits=3).split(X, groups=groups): train_groups = {groups[i] for i in train_idx} test_groups = {groups[i] for i in test_idx} assert train_groups.isdisjoint(test_groups) # no subject leaks across + +# Same thing, with the reader building the placeholder X for you: +for train_idx, test_idx in spec.group_kfold(n_splits=3): + ... ``` +To keep the outcome balanced across folds *as well as* keeping subjects +together, use the stratum annotation. The reader has a helper that wires both +in, so the caller never has to line up the two vectors by hand: + +```python +from sklearn.model_selection import StratifiedGroupKFold + +# Explicit form: grouping and stratum come from the same spec, in file order. +for train_idx, test_idx in StratifiedGroupKFold(n_splits=2).split( + X, y=spec.strata(), groups=spec.groups()): + ... + +# Equivalent one-liner: +for train_idx, test_idx in spec.stratified_group_kfold(n_splits=2): + ... +``` + +`strata()` returns the `stratum` column by default; pass a column name to +stratify on something else, such as a blocking variable. It never raises — when +the spec carries no stratum it returns `None` for every sample, which is what a +file written before schema 0.3.0 looks like (`spec.stratum_var` is `None` +there). The check happens one level up: `stratified_group_kfold()` raises +`ValueError` rather than handing scikit-learn a `y` full of `None`. + For an ordered evaluation (a `mode = "time"` spec), sort by `order_rank` first and use `TimeSeriesSplit`: @@ -173,3 +324,7 @@ dependency structure — and every other language merely *reproduces* it from th two sides cannot drift. `split_spec` is the contract; scikit-learn (here) and `rsample` (on the R side) are just interchangeable consumers of it. That is what makes it an interchange format rather than internal plumbing for any one tool. + +```{r cleanup, include = FALSE} +unlink(path) +``` diff --git a/vignettes/faq-design-notes.Rmd b/vignettes/faq-design-notes.Rmd new file mode 100644 index 0000000..3245f26 --- /dev/null +++ b/vignettes/faq-design-notes.Rmd @@ -0,0 +1,231 @@ +--- +title: "FAQ and design notes" +output: + rmarkdown::html_vignette: + toc: true +vignette: > + %\VignetteIndexEntry{FAQ and design notes} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r setup, include = FALSE} +knitr::opts_chunk$set(collapse = TRUE, comment = "#>") +library(splitGraph) +``` + +## Why not just call `make_split_plan(group = , batch = )` directly? + +For a dataset with one subject column and one batch column you should: bioLeak's +`make_split_plan()` reaches the same grouping in one call, and splitGraph adds a +hop. splitGraph earns its place when the structure is not one clean column per +axis: + +- **Validation before splitting.** A sample linked to two subjects, a subject + that appears in two studies or at two sites, a `time_index` that contradicts + `timepoint_precedes`: `validate_graph()` reports these before any fold exists. + Column-based grouping silently produces folds from inconsistent metadata. +- **Composite semantics.** `mode = "composite"` merges samples into connected + components over *all* chosen relations. bioLeak's `combined` mode instead + picks a primary axis and deletes training rows sharing a secondary level with + the test set. Same metadata, different partitions; splitGraph makes the choice + explicit and reproducible. +- **Pairwise relations.** Genetic relatedness and spatial adjacency are graded + properties of *pairs*, not categories. `relatedness_edges_from_kinship()` and + `spatial_edges_from_coords()` threshold them into edges and the derivation + takes connected components. No categorical column can express this. +- **Provenance and interchange.** The `split_spec` records which relations, + thresholds and strategy produced each group, and travels as schema-checked + JSON to Python or any other consumer. + +## When does composite-strict over-merge? + +Strict composite grouping is transitive closure. If sample A shares a subject +with B, and B shares a batch with C, then A, B and C land in one group even +though A and C share nothing directly. With a few large batches this collapses +most of the dataset into one component: + +```{r overmerge} +meta <- data.frame( + sample_id = paste0("S", 1:6), + subject_id = c("P1", "P1", "P2", "P2", "P3", "P3"), + batch_id = c("B1", "B2", "B2", "B3", "B3", "B1"), + stringsAsFactors = FALSE +) +g <- graph_from_metadata(meta) +table(grouping_vector(derive_split_constraints(g, "composite", via = c("subject", "batch")))) +``` + +Every subject bridges two batches, so all six samples form a single group and no +split is possible. Three remedies, in order of preference: + +1. Ask whether every relation really *must* be severed. Grouping by subject + alone here yields three groups; batch can be handled as a blocking + annotation instead (`spec$block_vars`). +2. Use `strategy = "rule_based"`: each sample is grouped by the first relation + in `priority` that is available to it, so relations do not chain. +3. Use `detect_dependency_components()` to see the component sizes before + deriving, and `summarize_leakage_risks()` to see which leakage paths a given + mode actually severs (`severed` column). + +```{r remedies} +grouping_vector(derive_split_constraints(g, "composite", strategy = "rule_based", + via = c("subject", "batch"), + priority = c("subject", "batch"))) +``` + +## How do thresholds interact with transitive closure? + +`relatedness_edges_from_kinship(pairs, threshold)` keeps a pair when its kinship +is *at least* the threshold; `spatial_edges_from_coords(coords, radius)` keeps a +pair when its distance is *at most* the radius. The derivation then forms +connected components over the kept edges. Two consequences: + +- Lowering a kinship threshold (or raising a radius) can only merge groups, + never split them, and the merging is not local: a chain of individually + just-over-threshold pairs joins its endpoints even if they are unrelated. +- The threshold is a property of the *edge set*, recorded on it and carried + into `graph$metadata$edge_sources` and `spec$metadata$threshold`, so a + reader of the spec can see which cut produced the groups. + +```{r threshold} +pairs <- data.frame(id1 = c("P1", "P2"), id2 = c("P2", "P3"), kinship = c(0.26, 0.13)) +meta <- data.frame(sample_id = c("S1", "S2", "S3"), subject_id = c("P1", "P2", "P3")) +build <- function(threshold) { + g <- build_dependency_graph( + list(create_nodes(meta, "Sample", "sample_id"), create_nodes(meta, "Subject", "subject_id")), + list(create_edges(meta, "sample_id", "subject_id", "Sample", "Subject", "sample_belongs_to_subject"), + relatedness_edges_from_kinship(pairs, threshold = threshold)) + ) + grouping_vector(derive_split_constraints(g, "relatedness")) +} +build(0.25) # only P1~P2 pass: {S1,S2}, {S3} +build(0.10) # P2~P3 also passes and chains: {S1,S2,S3} +``` + +## What does the `stratum` column mean, and does splitGraph stratify? + +No. `stratum` is an *annotation*: the outcome level attached to each sample +(from `sample_has_outcome`, or the subject's outcome via `subject_has_outcome`). +It is exposed through `spec$stratum_var` so a consumer such as scikit-learn's +`StratifiedGroupKFold` or bioLeak's `stratify = TRUE` can balance folds. +Balancing is execution and belongs downstream; splitGraph only describes. + +## Schema versioning policy, in one place + +- `schema_version` (currently `r splitGraph:::.depgraph_schema_version`) is + independent of the package version. It describes the on-disk JSON contract. +- The **major** component is the compatibility boundary. Files sharing the + installed major load silently; readers fill fields missing from older files + with `NA` and ignore unknown ones. A differing major loads with a warning + suggesting `migrate_dependency_graph_json()` / `migrate_split_spec_json()`. +- Additive changes (a new column, a new metadata field) bump the minor + component. Only a rename or a change of meaning would bump the major, and + none has happened. +- The formal JSON Schemas live under `inst/schema//`, and every + written file carries a `$schema` URL pointing at its own version, so the + reference stays valid after later bumps. `validate_graph_json()` and + `validate_split_spec_json()` (or `read_*(validate = TRUE)`) check a file + against the installed schema without a JSON Schema engine. + +The R reader is permissive at that boundary, which is worth seeing rather than +taking on trust: + +```{r schema-major, eval = requireNamespace("jsonlite", quietly = TRUE)} +tiny <- data.frame(sample_id = c("S1", "S2"), subject_id = c("P1", "P2"), + stringsAsFactors = FALSE) +g_tiny <- graph_from_metadata(tiny) +p <- tempfile(fileext = ".json") +write_split_spec(as_split_spec(derive_split_constraints(g_tiny, "subject"), + graph = g_tiny), p) + +# Pretend the file was written by a future splitGraph with a different major. +raw <- jsonlite::fromJSON(p, simplifyVector = FALSE) +raw$schema_version <- "1.0.0" +writeLines(jsonlite::toJSON(raw, auto_unbox = TRUE, null = "null"), p) + +back <- withCallingHandlers( + read_split_spec(p), + warning = function(w) { + message("warning: ", conditionMessage(w)) + invokeRestart("muffleWarning") + } +) +class(back) +unlink(p) +``` + +One asymmetry to know about if you consume the format outside R: the shipped +Python reader is *stricter*. Where R warns and loads, `splitspec` raises a +`ValueError` naming the version and refuses the file, on the grounds that a +non-interactive consumer is better off failing than silently misreading a format +it does not know. Both implementations accept every schema sharing major `0`. + +## Can I build a graph straight from a SummarizedExperiment? + +Yes. `graph_from_metadata()` is an S3 generic, and the +`SummarizedExperiment` method reads `colData()` as the metadata table. When +`colData` has no `sample_id` column the assay column names are used, so a +typical Bioconductor object needs no preparation at all. Pass +`sample_id_col =` to name a different column, and `columns =` to map your own +names onto the canonical ones exactly as for a data frame. + +```{r se, eval = requireNamespace("SummarizedExperiment", quietly = TRUE)} +meta <- data.frame( + sample_id = c("S1", "S2", "S3", "S4"), + subject_id = c("P1", "P1", "P2", "P2"), + batch_id = c("B1", "B2", "B1", "B2"), + stringsAsFactors = FALSE +) +se <- SummarizedExperiment::SummarizedExperiment( + assays = list(counts = matrix(0, nrow = 3, ncol = 4, + dimnames = list(NULL, meta$sample_id))), + colData = meta[, c("subject_id", "batch_id")] +) + +g_se <- graph_from_metadata(se, graph_name = "from-se") +grouping_vector(derive_split_constraints(g_se, "subject")) + +# identical to building from the data frame directly +identical( + grouping_vector(derive_split_constraints(g_se, "subject")), + grouping_vector(derive_split_constraints(graph_from_metadata(meta), "subject")) +) +``` + +## Which errors can I catch programmatically? + +Every error inherits from `splitgraph_error` and carries a `code`; see +`?splitgraph_conditions` for the subclasses (`splitgraph_schema_error`, +`splitgraph_reference_error`, `splitgraph_ambiguity_error`, +`splitgraph_validation_error`, `splitgraph_io_error`). + +```{r conditions} +g <- graph_from_metadata(data.frame(sample_id = c("S1", "S2"), subject_id = c("P1", "P2"))) +tryCatch( + query_neighbors(g, "sample:S9"), + splitgraph_reference_error = function(e) e$code +) +``` + +## How large a cohort can splitGraph handle? + +Every step is linear in nodes plus edges. On a 20,000-sample synthetic cohort +the shipped benchmark (`inst/bench/pipeline.R`) builds the graph, validates it, +derives a default composite constraint, enriches a spec and writes both JSON +files in about twelve seconds on a laptop. More than half of that is writing the +*graph* JSON (~6 s); the specification itself writes in well under a second, and +the derivation steps are hundredths of a second. If you only need the handoff +artifact, skip `write_dependency_graph()`. + +Two caveats about the guard rail. `tests/testthat/test-performance.R` is a +wall-clock *budget* at 5,000 samples with deliberately generous limits, not a +benchmark; only the composite derivation is additionally checked for scaling, +by timing 1,000 against 4,000 samples and failing if the ratio exceeds 8 (a +quadratic step would give roughly 16). Other steps could therefore degrade +somewhat without tripping it. + +The one inherently quadratic output is the explicit sample-pair table of +`detect_shared_dependencies()` and +`detect_dependency_components()$metadata$projection_edges`, whose size is the +number of pairs sharing a target; grouping itself never enumerates pairs. diff --git a/vignettes/leakage-aware-workflow.Rmd b/vignettes/leakage-aware-workflow.Rmd index 8ca6173..94327ba 100644 --- a/vignettes/leakage-aware-workflow.Rmd +++ b/vignettes/leakage-aware-workflow.Rmd @@ -314,6 +314,17 @@ tabular and `igraph` representations behind it. The summary is useful because it tells you exactly which entity types and relation types are present before you derive any split rules. +Both representations stay reachable. `graph$nodes` and `graph$edges` are the +tables; `as_igraph()` hands you the `igraph` object, with `node_type` and +`node_key` on the vertices and `edge_type` on the edges, so anything igraph can +compute is available without leaving the typed model: + +```{r as-igraph} +ig <- as_igraph(graph) +ig +igraph::vertex_attr_names(ig) +``` + ### Visualize the typed structure `plot()` renders the graph with a typed, layered layout: `Sample` on top, @@ -335,6 +346,96 @@ plot(graph, legend_position = "bottomright") plot(graph, node_colors = c(Sample = "#000000")) ``` +Two other views answer different questions. `focus = "sample_projection"` drops +the dependency nodes and draws only the samples, joined whenever they share a +dependency of a type in `via`: this is a picture of the grouping a composite +derivation would produce, and a connected blob is a warning that the split has +little room left. `focus = "ego"` zooms to one node's neighbourhood, which is +how you inspect a single subject or batch in a graph too large to read whole. + +```{r plot-focus, fig.width = 7, fig.height = 4} +plot(graph, focus = "sample_projection", via = c("Subject", "Batch")) +plot(graph, focus = "ego", node = "subject:P1", legend = FALSE) +``` + +### Reshaping a graph you already have + +You do not have to go back to the node and edge sets to change a graph. +`subset_graph()` restricts it to a set of samples and keeps the structure those +samples actually reach; `combine_graphs()` takes the union of several graphs, +rejecting contradictory definitions of the same node; and `add_edges()` appends +an edge set, for example one produced later from a kinship table. Each returns +a new, independently validated graph and leaves its inputs untouched. + +```{r graph-edit} +train_graph <- subset_graph(graph, samples = c("S1", "S2", "S3", "S4")) +summary(train_graph)$node_types + +# Grouping on the subset graph agrees with asking for a subset directly. +identical( + grouping_vector(derive_split_constraints(train_graph, mode = "subject")), + grouping_vector(derive_split_constraints(graph, mode = "subject", + samples = c("S1", "S2", "S3", "S4"))) +) +``` + +`combine_graphs()` is the inverse operation, and the natural way to assemble a +cohort that arrived in pieces — one graph per batch of metadata, merged once +they are all in: + +```{r graph-combine} +rejoined <- combine_graphs( + subset_graph(graph, samples = c("S1", "S2", "S3")), + subset_graph(graph, samples = c("S4", "S5", "S6")), + graph_name = "rejoined" +) + +identical(summary(rejoined)$node_types, summary(graph)$node_types) +identical( + grouping_vector(derive_split_constraints(rejoined, mode = "subject")), + grouping_vector(derive_split_constraints(graph, mode = "subject")) +) +``` + +`add_edges()` covers the case where a relation only becomes available later. +Kinship, for instance, arrives as its own matrix rather than as a metadata +column; once you have it, thresholding it produces an edge set you can attach to +the graph you already built, and `mode = "relatedness"` becomes available on it: + +```{r graph-add-edges} +kinship_table <- data.frame( + id1 = c("P1", "P2"), + id2 = c("P2", "P3"), + kinship = c(0.25, 0.20), + stringsAsFactors = FALSE +) + +graph_with_kinship <- add_edges( + graph, + relatedness_edges_from_kinship(kinship_table, threshold = 0.1) +) + +summary(graph_with_kinship)$edge_types +grouping_vector(derive_split_constraints(graph_with_kinship, mode = "relatedness")) +``` + +`P1`, `P2` and `P3` form one relatedness component, so the five samples carried +by those three subjects can no longer be separated; `P4`'s single sample stays +on its own. The thresholded relations are covered in full further down and in the +*modeling-structure* vignette. + +### Exporting for other tools + +JSON is the interchange contract, but for a look at the graph in Cytoscape, +Gephi, or networkx, `export_graph()` writes GraphML, GML, or flat node and edge +tables. Attributes are flattened into `attr_*` columns, since those formats +cannot hold a nested list. + +```{r export, eval = FALSE} +export_graph(graph, "graph.graphml", format = "graphml") +export_graph(graph, "nodes.csv", format = "nodes_csv") +``` + ## Validate before you split Validation is where `splitGraph` starts paying off. The graph below is @@ -358,6 +459,39 @@ That output is the core value proposition of the package in one place: `valid = TRUE` here means the graph has no errors. It does not mean the dataset is free of leakage risk. Warnings and advisories still matter. +The report is a `depgraph_validation_report`: `print()` gives the severity +roll-up above and `as.data.frame()` the issue table, with one row per finding +and the node and edge ids it implicates. + +Findings arrive on three `level`s. **Structural** and **semantic** rules police +the graph itself — dangling edges, duplicate ids, an unsupported relation, a +sample assigned to two subjects, a `time_index` that contradicts the precedence +edges. The **leakage** layer is the one specific to this package, and it is +small enough to list in full: + +| `code` | Default severity | Fires when | +|---|---|---| +| `repeated_subject_samples` | advisory | a subject has more than one sample | +| `subject_cross_study_overlap` | warning | one subject's samples span several studies | +| `subject_cross_site_overlap` | warning | one subject's samples span several sites | +| `per_dataset_featureset` | advisory | a `FeatureSet` node declares `derivation_scope = "per_dataset"` | +| `shared_featureset_provenance` | advisory | one feature set is used by more than one sample | +| `missing_time_ordering` | warning | timepoint-linked samples exist with neither `time_index` nor `timepoint_precedes` | +| `heavy_batch_reuse` | advisory | one batch holds at least half the cohort (minimum 3 samples) | + +None of these are errors, because none of them is wrong on its own — a +longitudinal study is *supposed* to repeat subjects. They are the inputs to the +split decision, which is why the report describes and does not prescribe. + +Pass `levels = "leakage"` to run only that layer, and `severities =` to narrow +the returned table further: + +```{r validation-filter} +as.data.frame( + validate_graph(graph, levels = "leakage", severities = "warning") +)[, c("severity", "code", "message")] +``` + The package is also intentionally strict about silent failure. If you ask for a subset of samples and some of them do not resolve, it errors instead of dropping them. @@ -449,8 +583,35 @@ hidden. ## Query the graph to inspect hidden structure -You can inspect local provenance, trace paths, and project direct sample -dependencies. +Seven query functions read the graph without changing it. They all return a +`graph_query_result`, so `as.data.frame()` gives you a tidy table in every case. +Five of them work on the typed graph itself: + +| Function | Answers | +|---|---| +| `query_node_type()` | which nodes of a given type exist | +| `query_edge_type()` | which edges of a given relation exist, optionally around given nodes | +| `query_neighbors()` | what a node is directly attached to | +| `query_paths()` | *every* simple route between two nodes | +| `query_shortest_paths()` | the shortest such route | + +and two project the graph down to samples — `detect_shared_dependencies()` and +`detect_dependency_components()` — which is what the splitting question actually +asks. + +Start with the inventory queries. They are the fastest way to check that the +graph contains what you think it contains: + +```{r inventory-queries} +as.data.frame(query_node_type(graph, "Batch"))[, c("node_id", "node_type", "node_key")] + +# Which samples went through batch B1? +as.data.frame( + query_edge_type(graph, "sample_processed_in_batch", node_ids = "batch:B1") +)[, c("edge_id", "from", "to")] +``` + +Then inspect local provenance and trace paths. ```{r neighbors-and-paths} neighbors_s1 <- query_neighbors(graph, node_ids = "sample:S1", direction = "out") @@ -473,6 +634,27 @@ second shows that `S1` reaches the subject-level outcome through its subject node, which is exactly the kind of relationship that would stay implicit in a plain metadata table. +`query_shortest_paths()` returns one route. When the question is *how many +different ways* two samples are entangled, use `query_paths()`, which enumerates +every simple path. Setting `mode = "all"` ignores edge direction — dependency +edges point from the sample outwards, so any sample-to-sample route has to +traverse one of them backwards — and `max_length = 2` restricts the answer to +dependencies shared one hop away: + +```{r all-paths} +s1_to_s6 <- query_paths(graph, from = "sample:S1", to = "sample:S6", + mode = "all", max_length = 2) +s1_to_s6 +as.data.frame(s1_to_s6)[, c("path_id", "step", "node_id", "node_type")] +``` + +Three separate routes connect `S1` and `S6`: the batch, the assay, and the +feature set. A single shared column would have shown you one of them. +`max_length` defaults to a finite cap of 8 edges so that a dense graph cannot +make the enumeration explode; when a returned path sits at the cap, the result +records `metadata$truncated = TRUE` to say longer routes may have been +suppressed. Pass `max_length = Inf` to search exhaustively. + ```{r projected-dependencies} shared_dependencies <- detect_shared_dependencies( graph, @@ -652,6 +834,17 @@ head(subject_then_block_by_site$sample_data[, c("sample_id", "group_id", "site_g Samples assigned to more than one site are rejected rather than silently resolved, by both `validate_graph()` and `derive_split_constraints(mode = "site")`. +Validation also watches the other direction. Subject `P3` above contributed `S5` +at `NYC` and `S6` at `BOS`, so a site-grouped split would separate two samples +from the same person — the mirror image of the cross-study overlap seen earlier, +and the reason to read the validation report before committing to a mode: + +```{r site-validation} +as.data.frame(validate_graph(site_graph))[ + , c("severity", "code", "message") +] +``` + ### Region The `Region` relation works the same way for a categorical tissue or anatomical @@ -835,7 +1028,8 @@ split_spec <- as_split_spec(strict_constraint, graph = graph) split_spec as.data.frame(split_spec)[, c( - "sample_id", "group_id", "batch_group", "study_group", "timepoint_id", "order_rank" + "sample_id", "group_id", "batch_group", "study_group", + "stratum", "timepoint_id", "order_rank" )] split_spec_validation <- validate_split_spec(split_spec) @@ -847,15 +1041,29 @@ This translation step is where the package becomes operational for downstream evaluation workflows: - `group_id` carries the split unit -- `batch_group` and `study_group` are available for blocking +- `batch_group` and `study_group` are available for blocking, alongside + `site_group`, `region_group`, `platform_group` and `assay_group` when the + graph carries those relations - `order_rank` is available for ordered evaluation +- `stratum` carries the outcome level each sample has, so a consumer can + stratify; it is an annotation only, and `splitGraph` never balances folds - the generated object is validated before handoff +The declared roles are readable off the spec itself, which is what an adapter +keys on rather than guessing column names: + +```{r spec-roles} +split_spec$group_var +split_spec$block_vars +split_spec$time_var +split_spec$stratum_var +``` + ## Summarize the leakage picture in one object The final helper combines graph validation, constraint diagnostics, and -split-spec readiness into one summary object. Crucially, when you pass the -`constraint` you chose, the summary reports a `severed` column: whether that +split-spec readiness into one `leakage_risk_summary` object. Crucially, when +you pass the `constraint` you chose, it reports a `severed` column: whether that constraint **structurally eliminates** each leakage path (`TRUE`), leaves it open (`FALSE`), or is not applicable (`NA`, e.g. for informational split-spec rows). @@ -874,12 +1082,16 @@ as.data.frame(risk_summary)[, c("source", "severity", "category", "severed", "me Read the `severed` column against the constraint you actually chose. Here the strict composite constraint (`via = c("Subject", "Batch")`) severs the subject, cross-study, and batch-reuse risks (`TRUE`) because those samples are forced -into the same group — but it does **not** address `missing_time_ordering` or +into the same group — but it does **not** address `per_dataset_featureset` or `shared_featureset_provenance` (`FALSE`), which are orthogonal to a -subject/batch grouping. That distinction is the point: the summary tells you -which of your surfaced risks your split design has actually handled, and which -still need attention (a different mode, a blocking variable, or a data fix) — -so the leakage trade-off is explicit before any model is trained. +subject/batch grouping: every sample shares `FS_GLOBAL`, so no grouping of +samples can undo a feature set that was fitted on the whole cohort. The +`NA` rows are the constraint and split-spec diagnostics, which describe +readiness rather than a leakage path. That distinction is the point: the +summary tells you which of your surfaced risks your split design has actually +handled, and which still need attention (a different mode, a blocking variable, +or a data fix) — so the leakage trade-off is explicit before any model is +trained. ## Downstream handoff @@ -908,10 +1120,12 @@ any package that wants to consume a `split_spec` — for example, on top of If the downstream consumer is in a different R session — or in a different language entirely — write the spec (and, if useful, the graph) to JSON. The -on-disk format has a formal JSON Schema (Draft 2020-12) shipped in -`inst/schema/`, and each written file references it via a `$schema` key. You can -validate a handoff file against that contract with `validate_split_spec_json()` -before consuming it, and `NA` values round-trip as JSON `null`. +on-disk format has a formal JSON Schema (Draft 2020-12) shipped under +`inst/schema//`, and each written file references its own +version via a `$schema` key, so the reference stays valid after later schema +bumps. You can validate a handoff file against that contract with +`validate_split_spec_json()` before consuming it, or ask the reader to do it by +passing `validate = TRUE`, and `NA` values round-trip as JSON `null`. ```{r serialize, eval = requireNamespace("jsonlite", quietly = TRUE)} spec_path <- tempfile(fileext = ".json") @@ -920,13 +1134,76 @@ write_split_spec(split_spec, spec_path) # Validate the file against the shipped JSON Schema. validate_split_spec_json(spec_path)$valid -# Round-trip it back into R unchanged. -spec_round_trip <- read_split_spec(spec_path) +# Round-trip it back into R unchanged. `validate = TRUE` checks the file +# against the shipped schema before parsing and runs the preflight validator +# on the result, failing with a classed error instead of a silent surprise. +spec_round_trip <- read_split_spec(spec_path, validate = TRUE) identical(split_spec$sample_data$group_id, spec_round_trip$sample_data$group_id) unlink(spec_path) ``` +The graph itself serialises the same way, which is what you want when the +consumer needs the *reasoning* and not only the answer — an audit trail, a +reviewer re-deriving a different mode, or a pipeline that builds the graph once +and derives several constraints later. `write_dependency_graph()` / +`read_dependency_graph()` are the pair, and `validate_graph_json()` is the +file-level check: + +```{r serialize-graph, eval = requireNamespace("jsonlite", quietly = TRUE)} +graph_path <- tempfile(fileext = ".json") +write_dependency_graph(graph, graph_path) + +validate_graph_json(graph_path)$valid + +graph_round_trip <- read_dependency_graph(graph_path, validate = TRUE) + +# The typed structure survives exactly ... +identical(as.data.frame(graph$edges), as.data.frame(graph_round_trip$edges)) +identical(summary(graph), summary(graph_round_trip)) + +# ... and so does everything derived from it. +identical( + grouping_vector(derive_split_constraints(graph_round_trip, mode = "subject")), + grouping_vector(subject_constraint) +) +identical( + as.data.frame(validate_graph(graph)), + as.data.frame(validate_graph(graph_round_trip)) +) +``` + +One JSON detail is worth knowing: the free-form `attrs` bag on each node is +written with ordinary JSON semantics, so an attribute that was `NA` in R comes +back as `NULL` rather than `NA`. Both mean "not recorded" and nothing in +`splitGraph` reads `attrs` to derive a constraint — node and edge types, +identifiers and relations, which is what the split logic uses, round-trip +unchanged. + +Both writers stamp the file with the schema version they were produced under and +a `$schema` URL that points at that exact version, so the reference keeps +resolving after a later schema bump: + +```{r schema-stamp, eval = requireNamespace("jsonlite", quietly = TRUE)} +on_disk <- jsonlite::fromJSON(graph_path, simplifyVector = FALSE) +on_disk$schema_version +sub(".*/schema/", "", on_disk[["$schema"]]) +``` + +That stamp is what makes an old file readable by a newer splitGraph. When a file +predates the installed schema, `migrate_dependency_graph_json()` and +`migrate_split_spec_json()` rewrite it at the current version, filling anything +introduced since with its default — a missing `split_spec` column becomes `NA` +rather than an error. Files already current are rewritten unchanged, so the call +is safe to run unconditionally on an archive: + +```{r migrate, eval = requireNamespace("jsonlite", quietly = TRUE)} +migrated <- migrate_dependency_graph_json(graph_path, tempfile(fileext = ".json")) +validate_graph_json(migrated)$valid + +unlink(c(graph_path, migrated)) +``` + Because the format is a documented, versioned contract, consumers are not limited to R. The package ships a pure-Python reference reader (`inst/python`) that recovers the same grouping and ordering and drives scikit-learn resamplers; diff --git a/vignettes/modeling-structure.Rmd b/vignettes/modeling-structure.Rmd index 591f6e2..fb10194 100644 --- a/vignettes/modeling-structure.Rmd +++ b/vignettes/modeling-structure.Rmd @@ -33,58 +33,110 @@ models several further leakage axes, in two families: edges and grouped by transitive closure, a partition a single categorical column cannot express. -This vignette builds and groups by each, and shows how the threshold drives the -pairwise grouping. +This vignette builds and groups by each, shows how the threshold drives the +pairwise grouping, and points out the two ways a structure-aware grouping goes +wrong — collapsing into one group, or dissolving into singletons. # Cluster-style relations: site, region, platform, assay `graph_from_metadata()` auto-detects `site_id`, `region_id`, `platform_id`, and `assay_id` columns and builds the corresponding typed nodes and edges. Each then -has its own constraint mode. The example below uses site, platform, and assay; -`region` behaves identically (a `region_id` column and `mode = "region"`) and is -omitted only to keep the output short. +has its own constraint mode, and all four behave identically — only the column +and the mode name change. ```{r cluster} meta <- data.frame( sample_id = paste0("S", 1:6), subject_id = c("P1", "P1", "P2", "P2", "P3", "P3"), site_id = c("NYC", "NYC", "BOS", "BOS", "NYC", "BOS"), - platform_id = c("illumina", "illumina", "nanopore", "nanopore", "illumina", "nanopore"), + region_id = c("cortex", "cortex", "cortex", + "hippocampus", "hippocampus", "hippocampus"), + platform_id = c("illumina", "illumina", "nanopore", + "nanopore", "illumina", "nanopore"), assay_id = c("rnaseq", "rnaseq", "rnaseq", "wgs", "wgs", "wgs"), stringsAsFactors = FALSE ) g <- graph_from_metadata(meta, graph_name = "structure-demo") -grouping_vector(derive_split_constraints(g, mode = "site")) -grouping_vector(derive_split_constraints(g, mode = "platform")) -grouping_vector(derive_split_constraints(g, mode = "assay")) +cluster_modes <- c("site", "region", "platform", "assay") +do.call(cbind, lapply( + stats::setNames(cluster_modes, cluster_modes), + function(m) grouping_vector(derive_split_constraints(g, mode = m)) +)) +``` + +Each column is a different, equally defensible partition of the same six +samples. Choosing between them is a scientific question, not a technical one: +which of these axes must a model generalise across? + +Site structure also has a validation rule of its own. A subject whose samples +were collected at more than one site is flagged, because grouping by site alone +would then place one individual on both sides of a split: + +```{r cross-site} +report <- validate_graph(g) +report$issues[report$issues$code == "subject_cross_site_overlap", + c("severity", "message")] + +# Which constraint modes actually sever that path: +risks <- summarize_leakage_risks(g, constraint = derive_split_constraints(g, "subject")) +as.data.frame(risks)[as.data.frame(risks)$category == "subject_cross_site_overlap", + c("category", "severed")] ``` Whatever mode is primary, every detected cluster relation is also carried into the `split_spec` as a *blocking annotation*, so a downstream consumer can block -on site, platform, or assay even when the split unit is something else — here, -subject: +on site, region, platform, or assay even when the split unit is something else +— here, subject: ```{r block-annotations} spec <- as_split_spec(derive_split_constraints(g, mode = "subject"), graph = g) spec$block_vars -head(spec$sample_data[, c("sample_id", "group_id", - "site_group", "platform_group", "assay_group")]) +head(spec$sample_data[, c("sample_id", "group_id", "site_group", + "region_group", "platform_group", "assay_group")]) ``` Any of these relations can also participate in a **composite** derivation, where several dependency sources are combined and each connected component becomes one -group: +group. Site and platform partition this cohort the same way, so grouping on both +at once still leaves two groups: ```{r composite} constraint <- derive_split_constraints( g, mode = "composite", strategy = "strict", - via = c("Subject", "Site", "Platform") + via = c("Site", "Platform") ) grouping_vector(constraint) ``` +### Watch for a composite that collapses + +A strict composite can only ever *merge* groups, never split them, so every +relation you add risks merging everything. Add subject to the same call and the +entire cohort becomes one group: + +```{r composite-collapse} +collapsed <- derive_split_constraints( + g, mode = "composite", strategy = "strict", + via = c("Site", "Platform", "Subject") +) +collapsed$metadata$n_groups +grouping_vector(collapsed) +``` + +The validation report predicted this. `subject_cross_site_overlap` fired above +because subject `P3` has one sample at each site; in a composite closure that +subject is a bridge, so the `NYC` and `BOS` groups fuse and there is nothing +left to hold out. One group is not an error — it is an arithmetically correct +answer to the question that was asked — and `splitGraph` does not warn about it, +so read `metadata$n_groups` before you rely on a composite. + +Two ways out, both already on this page: leave the bridging relation out of +`via` (the `Site` + `Platform` call above), or keep the coarse axis as a +*blocking annotation* rather than the split unit, which is what `site_group` in +the spec is for. `vignette("faq-design-notes")` works through the trade-off. + # Pairwise relation: genetic relatedness Some leakage is pairwise and continuous rather than a clean grouping. Genetic @@ -123,6 +175,56 @@ rel_groups <- grouping_vector(derive_split_constraints(g_rel, mode = "relatednes rel_groups ``` +Real kinship tools rarely use those exact column names, and they do not all +emit the long format. Both shapes are accepted. KING and GCTA write a long +table with their own headers, which `id1` / `id2` / `kinship` rename: + +```{r kinship-columns} +king <- data.frame( + ID1 = c("P1", "P2", "P1", "P5"), + ID2 = c("P2", "P3", "P4", "P6"), + Kinship = c(0.25, 0.20, 0.02, 0.30), + stringsAsFactors = FALSE +) +king_edges <- relatedness_edges_from_kinship( + king, threshold = 0.1, id1 = "ID1", id2 = "ID2", kinship = "Kinship" +) +as.data.frame(king_edges)[, c("from", "to")] +``` + +PLINK's `--make-rel square` instead writes a square GRM. Pass the matrix +directly, with the subject ids as its dimnames; it is expanded to its +upper-triangle pairs before thresholding, so the diagonal never becomes a +self-edge: + +```{r kinship-matrix} +grm <- matrix( + c(0.50, 0.25, 0.02, 0.00, + 0.25, 0.50, 0.20, 0.00, + 0.02, 0.20, 0.50, 0.00, + 0.00, 0.00, 0.00, 0.50), + nrow = 4, byrow = TRUE, + dimnames = list(paste0("P", 1:4), paste0("P", 1:4)) +) + +as.data.frame(relatedness_edges_from_kinship(grm, threshold = 0.1))[ + , c("from", "to") +] +``` + +Whichever shape you start from, the value that passed the threshold is kept on +the edge, so you can always see *why* a pair was linked rather than trusting the +grouping blind: + +```{r kinship-attrs} +kept <- as.data.frame(query_edge_type(g_rel, "subject_related_to")) +data.frame( + from = kept$from, + to = kept$to, + kinship = vapply(kept$attrs, function(a) a$kinship, numeric(1)) +) +``` + The grouping is a transitive closure over the `subject_related_to` edges. The network below draws those edges between subjects, coloured by the relatedness group each subject (and therefore its samples) lands in: the P1–P2–P3 chain @@ -161,13 +263,38 @@ g_rel_strict <- build_dependency_graph(list(samples, subjects), list(belongs, re grouping_vector(derive_split_constraints(g_rel_strict, mode = "relatedness")) ``` +Push the threshold further and the relation stops doing much work: samples end +up alone in their own groups, which protects nothing. That case *is* detected — +once more than half the samples sit in a group of one, the pairwise deriver +records it in `metadata$warnings`, so a cut that quietly switched the relation +off does not pass unnoticed: + +```{r rel-sparse} +sparse <- derive_split_constraints( + build_dependency_graph( + list(samples, subjects), + list(belongs, relatedness_edges_from_kinship(kin, threshold = 0.28)) + ), + mode = "relatedness" +) +sparse$metadata$n_groups +sparse$metadata$warnings +``` + +That is the sparse end of the same trade-off the collapsing composite showed at +the dense end: too permissive a cut merges the cohort into one unusable group, +too strict a cut dissolves it into singletons that protect nothing. The +threshold is where you choose between them. + # Pairwise relation: spatial proximity Spatial proximity works the same way over sample coordinates — for example spot locations from spatial transcriptomics, positions on a tissue slide, or geographic site coordinates. `spatial_edges_from_coords()` connects samples within a radius (Euclidean distance over the coordinate columns), and -`mode = "spatial"` groups the resulting connected components. +`mode = "spatial"` groups the resulting connected components. The distance is +computed over as many coordinate columns as you give it, so a `z` column for a +tissue volume works exactly like a plain `x`/`y` slide. ```{r spatial} # Two spatial clusters. Cluster 1 (S1-S3) is a chain: neighbouring pairs are @@ -220,6 +347,26 @@ legend("topleft", legend = levels(sp_grp), pch = 19, col = palette_sp[seq_along(levels(sp_grp))], title = "Spatial group", bty = "n") ``` +One thing to watch in a real coordinate table. When `coord_cols` is not given, +every numeric column except the id is treated as a coordinate — so a QC metric +or a slide number sitting in the same frame silently joins the distance +calculation and can switch the relation off entirely: + +```{r coord-cols} +coords_qc <- cbind(coords, reads_millions = c(31, 44, 12, 38, 27, 51)) + +# `reads_millions` is picked up as a third dimension: nothing is within radius. +nrow(as.data.frame(spatial_edges_from_coords(coords_qc, radius = 1.5))) + +# Naming the coordinate columns restores the five adjacency edges. +nrow(as.data.frame( + spatial_edges_from_coords(coords_qc, radius = 1.5, coord_cols = c("x", "y")) +)) +``` + +Pass `coord_cols` whenever the frame carries anything numeric that is not a +coordinate. + # Deriving on a subset is leakage-safe Real splits are derived on a *subset* of samples — the training rows, say. For @@ -239,6 +386,86 @@ grouping_vector( ) ``` +A subset is sometimes better expressed as a graph in its own right, for example +when you want to validate it, plot it, or hand it around. `subset_graph()` does +that, and it uses the same rule, so the grouping agrees with `samples =`: + +```{r subset-graph} +g_two <- subset_graph(g_sp, samples = c("S1", "S3"), graph_name = "S1 + S3") +grouping_vector(derive_split_constraints(g_two, mode = "spatial")) +``` + +# Combining a pairwise relation with a direct one + +Pairwise relations are not a separate world: either of them can be listed in a +composite `via` alongside the direct relations, and all of them feed the same +connected-component search. That matters when two different mechanisms each link +a different pair of samples, and severing only one would leave the other open. + +Here relatedness links two subjects that share no batch, while batch links two +samples from unrelated subjects. Neither relation alone separates the cohort +correctly; the composite does. + +The graphs earlier on this page were assembled node set by node set to keep +every piece visible, but a pairwise relation does not require that. Build the +direct structure from the metadata frame as usual, then attach the thresholded +edges to it with `add_edges()`: + +```{r composite-pairwise} +meta_c <- data.frame( + sample_id = paste0("S", 1:4), + subject_id = paste0("P", 1:4), + batch_id = c("B1", "B1", "B2", "B3"), + stringsAsFactors = FALSE +) +kin_c <- data.frame(id1 = "P2", id2 = "P3", kinship = 0.25, stringsAsFactors = FALSE) + +g_mixed <- add_edges( + graph_from_metadata(meta_c, graph_name = "mixed-structure"), + relatedness_edges_from_kinship(kin_c, threshold = 0.1) +) + +# batch alone: {S1,S2} {S3} {S4} relatedness alone: {S2,S3} +grouping_vector(derive_split_constraints(g_mixed, "batch")) +grouping_vector(derive_split_constraints(g_mixed, "relatedness")) + +# combined, the chain S1-S2 (batch) - S3 (kinship) becomes one group: +mixed <- derive_split_constraints(g_mixed, "composite", via = c("batch", "relatedness")) +grouping_vector(mixed) +mixed$metadata$via +``` + +Note what `via` accepts and where. `derive_split_constraints()` takes either a +lower-case mode or a node type, and pairwise modes are valid there — that is +what makes the call above possible. The graph-level views take node types only: +`detect_dependency_components()` and `plot(focus = "sample_projection")` project +samples through `Subject`, `Batch` and friends, and reject `"relatedness"`, +because a pairwise relation is an edge set rather than a node type to route +through. Use the derivation to combine them and `grouping_vector()` to read the +result. + +Under `strategy = "rule_based"` a pairwise source behaves as a fallback instead: +a sample takes the first relation in `priority` that gives it a non-singleton +group, so relations never chain. + +Whichever route you take, the threshold that produced the edges is recorded on +the graph, per relation, and is serialised with it — so a reader of the file can +see which cut created the grouping: + +```{r threshold-provenance} +g_mixed$metadata$edge_sources$subject_related_to[c("threshold", "metric")] +``` + +A spec derived from a *single* pairwise mode also carries that threshold as a +scalar in its own metadata. A composite spec does not, because several +relations (each with its own cut) may have contributed; the graph's +`edge_sources` is the complete record in that case: + +```{r threshold-in-spec} +as_split_spec(derive_split_constraints(g_mixed, "relatedness"), + graph = g_mixed)$metadata[c("threshold", "threshold_metric")] +``` + # Thresholds are inputs, not modeling Because the threshold (kinship cutoff, spatial radius) is applied up front in the diff --git a/vignettes/quick-start.Rmd b/vignettes/quick-start.Rmd new file mode 100644 index 0000000..c4e7c8a --- /dev/null +++ b/vignettes/quick-start.Rmd @@ -0,0 +1,248 @@ +--- +title: "Quick start: from a metadata table to a split_spec in ten minutes" +output: + rmarkdown::html_vignette: + toc: true +vignette: > + %\VignetteIndexEntry{Quick start: from a metadata table to a split_spec in ten minutes} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r setup, include = FALSE} +knitr::opts_chunk$set(collapse = TRUE, comment = "#>") +``` + +splitGraph turns a sample-level metadata table into a **typed dependency +graph**, validates it, derives a **split constraint** (which samples must stay +on the same side of any train/test split), and emits a tool-agnostic +**`split_spec`** that downstream resampling tools consume. It never creates +folds itself. + +This is the shortest complete path. Each step links to the vignette that goes +deeper. + +```{r load} +library(splitGraph) +``` + +## 1. A metadata table + +One row per sample. Only `sample_id` is required; every other canonical column +is optional, and absent ones are simply skipped. + +```{r meta} +meta <- data.frame( + sample_id = paste0("S", 1:8), + subject_id = c("P1", "P1", "P2", "P2", "P3", "P3", "P4", "P4"), + batch_id = c("B1", "B1", "B2", "B2", "B3", "B3", "B3", "B4"), + site_id = c("NYC", "NYC", "NYC", "NYC", "BOS", "BOS", "BOS", "BOS"), + timepoint_id = rep(c("T0", "T1"), 4), + time_index = rep(c(0, 1), 4), + outcome_id = c("case", "case", "ctrl", "ctrl", "case", "case", "ctrl", "ctrl"), + stringsAsFactors = FALSE +) +``` + +Four subjects, two samples each. Note batch `B3`: it holds samples from *two* +different subjects, which matters in step 3. + +`graph_from_metadata()` auto-detects these columns: + +| Canonical column | Creates | Available as | +|---|---|---| +| `sample_id` (required) | `Sample` nodes | every mode | +| `subject_id` | `Subject` + `sample_belongs_to_subject` | `mode = "subject"`, and the basis of `"relatedness"` | +| `batch_id` | `Batch` + `sample_processed_in_batch` | `mode = "batch"` | +| `study_id` | `Study` + `sample_from_study` | `mode = "study"` | +| `site_id` | `Site` + `sample_collected_at_site` | `mode = "site"` | +| `region_id` | `Region` + `sample_located_in_region` | `mode = "region"` | +| `platform_id` | `Platform` + `sample_run_on_platform` | `mode = "platform"` | +| `assay_id` | `Assay` + `sample_measured_by_assay` | `mode = "assay"` | +| `timepoint_id` (with `time_index`) | `Timepoint` + `sample_collected_at_timepoint` (+ `timepoint_precedes`) | `mode = "time"`, and `order_rank` | +| `featureset_id` | `FeatureSet` + `sample_uses_featureset` | not a constraint mode; feeds the shared-provenance advisory and the dependency queries | +| `outcome_id` or `outcome_value` | `Outcome` + `sample_has_outcome` | the `stratum` annotation | + +Identifier columns may be character, factor, or numeric; they are coerced to +character. If your columns are named differently, map them with `columns =`, +for example `columns = c(subject_id = "donor", batch_id = "run")`. Relations +that have no column, such as genetic relatedness or spatial proximity, are +built from their own helpers and added to the graph; see +`vignette("modeling-structure")`. + +## 2. Build and validate + +```{r build} +g <- graph_from_metadata(meta, graph_name = "quick-start") +g +validate_graph(g) +``` + +Validation runs three layers, and each issue carries a severity. **Structural** +problems (a dangling edge, a duplicate id) are errors and stop the build. +**Semantic** problems (a sample assigned to two subjects, a `time_index` that +contradicts the precedence edges) are errors or warnings. **Leakage** findings +are warnings or advisories: a subject appearing in two studies or at two sites +is a warning, while repeated measures of one subject are an advisory. This +cohort produces four of those advisories, one per subject, which is exactly the +structure the split has to respect. + +Use `levels =` and `severities =` to narrow the report, and +`validate_graph(g, error_on_fail = TRUE)` to stop on any error. + +Nothing has decided a split yet. The report describes what the data contains. + +## 3. Choose a constraint mode + +| Your question | `mode` | What ends up in one group | +|---|---|---| +| Same individual measured several times? | `"subject"` | all samples of a subject | +| Processing batch, plate, or run effects? | `"batch"` | all samples of a batch | +| Several studies or cohorts pooled? | `"study"` | all samples of a study | +| Multi-centre collection? | `"site"` | all samples of a site | +| Tissue region, sequencing platform, assay? | `"region"`, `"platform"`, `"assay"` | likewise | +| Longitudinal, and train must precede test? | `"time"` | samples of a timepoint, plus an `order_rank` | +| Genetic relatives or spatial neighbours? | `"relatedness"`, `"spatial"` | connected components over thresholded edges; see `?pairwise_edges` | +| Several of these at once? | `"composite"` | `strict`: one group per connected component over every relation in `via` (any of the above, including the pairwise ones). `rule_based`: the first relation in `priority` that the sample has | + +Start with the one relation you are most sure about. Here that is the subject: + +```{r derive-subject} +subject_constraint <- derive_split_constraints(g, mode = "subject") +subject_constraint +grouping_vector(subject_constraint) +``` + +`grouping_vector()` returns the group per sample as a named character vector, +which is the handle most resampling tools want. The full table, with the reason +each sample landed where it did, is one call away: + +```{r constraint-table} +head(as.data.frame(subject_constraint)[, c("sample_id", "group_id", "explanation")], 2) +``` + +If more than one relation has to be respected, combine them. Grouping by +subject *and* batch gives three groups rather than four, because batch `B3` +links subjects `P3` and `P4`, so they cannot be separated without splitting a +batch: + +```{r derive-composite} +composite_constraint <- derive_split_constraints( + g, mode = "composite", via = c("subject", "batch") +) +grouping_vector(composite_constraint) +``` + +That is the trade-off to watch: each relation you add can only merge groups, +never split them. With a few large batches a strict composite can collapse the +whole cohort into one group, which leaves nothing to hold out. +`vignette("faq-design-notes")` shows when that happens and what to do instead. + +## 4. Emit the split_spec + +```{r spec} +spec <- as_split_spec(subject_constraint, graph = g) +spec +``` + +Passing `graph = g` enriches the spec with everything the constraint did not +use as the primary grouping, so a downstream tool can block, order, or +stratify without ever touching the graph: + +```{r spec-roles} +spec$group_var # the split unit +spec$block_vars # coarser axes that ideally should not straddle a fold +spec$time_var # ordering, when the graph carries one +spec$stratum_var # the outcome level each sample has +``` + +Those names point into one sample-level table: + +```{r spec-table} +as.data.frame(spec)[, c("sample_id", "group_id", "batch_group", "site_group", + "stratum", "order_rank")] +``` + +The spec is checked before it leaves R: + +```{r spec-validate} +validate_split_spec(spec) +``` + +The `stratum` column is an *annotation*: it records which outcome level each +sample carries so a consumer can stratify. splitGraph never balances folds +itself. + +## 5. See which leakage paths the choice closes + +`summarize_leakage_risks()` folds the graph validation, the constraint, and the +spec into one object. The `severed` column is the useful part: it says whether +the mode you picked structurally eliminates each finding. + +```{r risks} +risks <- summarize_leakage_risks(g, constraint = subject_constraint, split_spec = spec) +risks +unique(as.data.frame(risks)[, c("category", "severity", "severed")]) +``` + +## 6. Hand off + +Write the spec to JSON for another session, another language, or an archive. +The format is a versioned contract with a JSON Schema shipped in the package: + +```{r write, eval = requireNamespace("jsonlite", quietly = TRUE)} +path <- tempfile(fileext = ".json") +write_split_spec(spec, path) + +validate_split_spec_json(path)$valid + +# Reading with validate = TRUE re-checks the file against the schema and runs +# the preflight validator, instead of trusting whatever is on disk. +back <- read_split_spec(path, validate = TRUE) +identical(back$sample_data$group_id, spec$sample_data$group_id) +``` + +In R, the reference consumer is bioLeak, which turns the spec into an +executable, leakage-audited split plan: + +```{r bioleak, eval = FALSE} +bioLeak::as_leaksplits(spec, data = my_frame, outcome = "y") +``` + +The released bioLeak (0.3.8) accepts the `subject`, `batch`, `study` and +`time` modes. For the others, including `composite`, hand it the grouping +directly; the split is identical, only the route differs: + +```{r bioleak-workaround, eval = FALSE} +joined <- merge(my_frame, spec$sample_data[, c("sample_id", "group_id")], + by = "sample_id") +bioLeak::make_split_plan(joined, outcome = "y", + mode = "subject_grouped", group = "group_id") +``` + +In Python, the reader ships with the package and needs only the standard +library: + +```python +from splitspec import load_split_spec + +spec = load_split_spec("split_spec.json") +spec.groups() # group per sample, for GroupKFold(groups=...) +spec.strata() # stratum per sample, for StratifiedGroupKFold(y=...) +spec.order_ranks() # sort by this before TimeSeriesSplit +``` + +## Where to go next + +- `vignette("leakage-aware-workflow")` — the same path in full, with querying, + validation overrides, every constraint mode, and graph editing. +- `vignette("modeling-structure")` — site, region, platform, assay, and the + thresholded relatedness and spatial relations. +- `vignette("cross-language-handoff")` — R to JSON to Python to scikit-learn. +- `vignette("adapter-cookbook")` — writing your own adapter. +- `vignette("case-study-gse60424")` — a real public cohort end to end. +- `vignette("faq-design-notes")` — why the design is shaped this way. + +```{r cleanup, include = FALSE} +if (exists("path")) unlink(path) +```