Compare commits

...

2 commits

Author SHA1 Message Date
613cdc34f4 update 2026-05-20 05:10:02 +02:00
8629a52530 update 2026-05-19 17:25:57 +02:00
5 changed files with 1505 additions and 704 deletions

View file

@ -19,6 +19,6 @@ git add -A
git commit -m "Deploy static site"
# Push this folder as the gh-pages branch of chmee/kidney
git push -f git@github.com:chmee/kidney.git main:gh-pages
git push -f git@github.com:chmlee/kidney.git master:gh-pages
cd -

View file

@ -14,6 +14,7 @@ library(survival)
library(emmeans)
library(foreign)
library(gtsummary)
library(ggsurvfit)
```
```{r}
@ -114,6 +115,29 @@ table.split <- dat.table1 |>
table.split
```
```{r}
table.split <- dat.table1 |>
select(sex, age.rec, age.donor, hla.match, cold.isc, tx.type) |>
tbl_summary(
by = tx.type,
statistic = list(
all_continuous() ~ "{median} ({p25}, {p75})"
),
label = list(
hla.match ~ "HLA matches, n(%)",
age.donor ~ "Donor age, median (IQR)",
age.rec ~ "Recipient age, median (IQR)",
cold.isc ~ "Cold ischemic time (hours), median (IQR), ",
sex ~ "Sex, n(%)"
),
missing = "ifany"
) |>
add_overall() |>
modify_footnote(all_stat_cols() ~ NA)
table.split
```
Calculate median follow-up (reverse Kaplan-Meier method), with 95% CI
```{r}
@ -367,9 +391,6 @@ recode.dat <- function(dat, time.intervals) {
df
}
```
```{r}
@ -525,29 +546,25 @@ recode.age <- function(dat, ages) {
dat.age.rec <- dat[!is.na(dat$age.rec), ]
class.age <- function(age) {
if (age < 2) {
return("0,1")
return("0-1")
} else if (age < 6) {
return("2,3,4,5")
return("2-5")
} else if (age < 11) {
return("6,7,8,9,10")
return("6-10")
} else if (age < 19) {
return("11-18")
}
}
```
```{r}
dat.age.rec$age.group <- sapply(dat.age.rec$age.rec, class.age) |>
factor(levels = c(
"0,1",
"2,3,4,5",
"6,7,8,9,10",
"0-1",
"2-5",
"6-10",
"11-18"
))
cox.age.rec <- coxph(Surv(follow.up, death) ~ age.group, data = dat.age.rec)
cox.age.rec |> summary()
```
```{r}
@ -555,6 +572,7 @@ emmeans(cox.age.rec, pairwise ~ age.group, type = "response")
```
# Exercise 7
Fit a multivariate Cox model by using other predictors and
@ -681,6 +699,7 @@ H1: PH-assumption doesn't hold
# different cox model!!
cox.final <- coxph(Surv(follow.up, death) ~ tx.type + age.rec + hla.match + age.donor, data = dat)
cox.zph(cox.final)
cox.final
```
@ -691,6 +710,11 @@ A non-random pattern or slope in a plot of scaled residuals against time indicat
plot(cox.zph(cox.final))
```
```{r, fig.width=10, fig.height=10}
plot(cox.zph(cox.final))
```
NOTES:

1233
slides.Rmd Normal file

File diff suppressed because it is too large Load diff

View file

@ -2214,6 +2214,48 @@ window.Quarto = {
<h1 data-number="2"><span class="header-section-number">2</span> Method &amp; Result</h1>
<section id="explain-dataset-m" class="level2" data-number="2.1">
<h2 data-number="2.1" class="anchored" data-anchor-id="explain-dataset-m"><span class="header-section-number">2.1</span> Explain Dataset (M)</h2>
<div class="callout callout-style-default callout-note callout-titled">
<div class="callout-header d-flex align-content-center">
<div class="callout-icon-container">
<i class="callout-icon"></i>
</div>
<div class="callout-title-container flex-fill">
Things to highlight in figures
</div>
</div>
<div class="callout-body-container callout-body">
<ul>
<li><p>sex and recipient age are similar across <code>tx.type</code></p></li>
<li><p>Living donors have less <code>hla.match</code> then cadaveric donors</p></li>
<li><p>There is age difference between different <code>tx.type</code></p></li>
</ul>
</div>
</div>
<section id="sex-tx.tpye" class="level3" data-number="2.1.1">
<h3 data-number="2.1.1" class="anchored" data-anchor-id="sex-tx.tpye"><span class="header-section-number">2.1.1</span> <code>sex</code> ~ <code>tx.tpye</code></h3>
<div class="callout callout-style-default callout-note callout-titled">
<div class="callout-header d-flex align-content-center">
<div class="callout-icon-container">
<i class="callout-icon"></i>
</div>
<div class="callout-title-container flex-fill">
Note
</div>
</div>
<div class="callout-body-container callout-body">
<p><code>sex</code> are similar across <code>tx.type</code></p>
</div>
</div>
<div class="cell">
<div class="cell-output-display">
<div>
<figure class="figure">
<p><img src="slides_files/figure-html/unnamed-chunk-13-1.png" class="img-fluid figure-img" width="672"></p>
</figure>
</div>
</div>
</div>
</section>
</section>
<section id="table-1-l" class="level2" data-number="2.2">
<h2 data-number="2.2" class="anchored" data-anchor-id="table-1-l"><span class="header-section-number">2.2</span> Table 1 (L)</h2>
@ -2230,7 +2272,7 @@ window.Quarto = {
<div class="cell-output-display">
<div>
<figure class="figure">
<p><img src="slides_files/figure-html/unnamed-chunk-14-1.png" class="img-fluid figure-img" width="672"></p>
<p><img src="slides_files/figure-html/unnamed-chunk-15-1.png" class="img-fluid figure-img" width="672"></p>
</figure>
</div>
</div>
@ -2239,11 +2281,37 @@ window.Quarto = {
<div class="cell-output-display">
<div>
<figure class="figure">
<p><img src="slides_files/figure-html/unnamed-chunk-15-1.png" class="img-fluid figure-img" width="672"></p>
<p><img src="slides_files/figure-html/unnamed-chunk-16-1.png" class="img-fluid figure-img" width="672"></p>
</figure>
</div>
</div>
</div>
<div class="callout callout-style-default callout-warning callout-titled">
<div class="callout-header d-flex align-content-center">
<div class="callout-icon-container">
<i class="callout-icon"></i>
</div>
<div class="callout-title-container flex-fill">
Warning
</div>
</div>
<div class="callout-body-container callout-body">
<p>TODO: change to percentage within each <code>tx.type</code></p>
</div>
</div>
<div class="callout callout-style-default callout-note callout-titled">
<div class="callout-header d-flex align-content-center">
<div class="callout-icon-container">
<i class="callout-icon"></i>
</div>
<div class="callout-title-container flex-fill">
Note
</div>
</div>
<div class="callout-body-container callout-body">
<p>Living donors have less <code>hla.match</code> then cadaveric donors</p>
</div>
</div>
</section>
<section id="donor-age-age.donor" class="level3" data-number="2.2.2">
<h3 data-number="2.2.2" class="anchored" data-anchor-id="donor-age-age.donor"><span class="header-section-number">2.2.2</span> Donor age <code>age.donor</code></h3>
@ -2265,7 +2333,7 @@ window.Quarto = {
<div class="cell-output-display">
<div>
<figure class="figure">
<p><img src="slides_files/figure-html/unnamed-chunk-17-1.png" class="img-fluid figure-img" width="672"></p>
<p><img src="slides_files/figure-html/unnamed-chunk-18-1.png" class="img-fluid figure-img" width="672"></p>
</figure>
</div>
</div>
@ -2278,7 +2346,7 @@ window.Quarto = {
<div class="cell-output-display">
<div>
<figure class="figure">
<p><img src="slides_files/figure-html/unnamed-chunk-18-1.png" class="img-fluid figure-img" width="768"></p>
<p><img src="slides_files/figure-html/unnamed-chunk-19-1.png" class="img-fluid figure-img" width="768"></p>
</figure>
</div>
</div>
@ -2291,28 +2359,15 @@ window.Quarto = {
<div class="cell-output-display">
<div>
<figure class="figure">
<p><img src="slides_files/figure-html/unnamed-chunk-19-1.png" class="img-fluid figure-img" width="672"></p>
<p><img src="slides_files/figure-html/unnamed-chunk-20-1.png" class="img-fluid figure-img" width="768"></p>
</figure>
</div>
</div>
</div>
</section>
<section id="recipient-age-age.rec" class="level3" data-number="2.2.3">
<h3 data-number="2.2.3" class="anchored" data-anchor-id="recipient-age-age.rec"><span class="header-section-number">2.2.3</span> Recipient Age <code>age.rec</code></h3>
<div class="cell">
<div class="sourceCode cell-code" id="cb9"><pre class="sourceCode r code-with-copy"><code class="sourceCode r"><span id="cb9-1"><a href="#cb9-1" aria-hidden="true" tabindex="-1"></a><span class="fu">mean</span>(dat<span class="sc">$</span>age.rec, <span class="at">na.rm =</span> <span class="cn">TRUE</span>)</span></code><button title="Copy to Clipboard" class="code-copy-button"><i class="bi"></i></button></pre></div>
<div class="cell-output cell-output-stdout">
<pre><code>[1] 11.64653</code></pre>
</div>
<div class="sourceCode cell-code" id="cb11"><pre class="sourceCode r code-with-copy"><code class="sourceCode r"><span id="cb11-1"><a href="#cb11-1" aria-hidden="true" tabindex="-1"></a><span class="fu">median</span>(dat<span class="sc">$</span>age.rec, <span class="at">na.rm =</span> <span class="cn">TRUE</span>)</span></code><button title="Copy to Clipboard" class="code-copy-button"><i class="bi"></i></button></pre></div>
<div class="cell-output cell-output-stdout">
<pre><code>[1] 13</code></pre>
</div>
</div>
<div class="cell">
<div class="cell-output cell-output-stderr">
<pre><code>Warning: Removed 9 rows containing non-finite outside the scale range
(`stat_count()`).</code></pre>
<pre><code>Warning: Removed 113 rows containing non-finite outside the scale range
(`stat_density()`).</code></pre>
</div>
<div class="cell-output-display">
<div>
@ -2335,23 +2390,36 @@ window.Quarto = {
</div>
</div>
</div>
<div class="callout callout-style-default callout-note callout-titled">
<div class="callout-header d-flex align-content-center">
<div class="callout-icon-container">
<i class="callout-icon"></i>
</div>
<div class="callout-title-container flex-fill">
Note
</div>
</div>
<div class="callout-body-container callout-body">
<p>There is age difference between different <code>tx.type</code></p>
</div>
</div>
</section>
<section id="recipient-age-age.rec" class="level3" data-number="2.2.3">
<h3 data-number="2.2.3" class="anchored" data-anchor-id="recipient-age-age.rec"><span class="header-section-number">2.2.3</span> Recipient Age <code>age.rec</code></h3>
<div class="cell">
<div class="cell-output cell-output-stderr">
<pre><code>Warning: Removed 9 rows containing non-finite outside the scale range
(`stat_count()`).</code></pre>
</div>
<div class="cell-output-display">
<div>
<figure class="figure">
<p><img src="slides_files/figure-html/unnamed-chunk-23-1.png" class="img-fluid figure-img" width="672"></p>
</figure>
<div class="sourceCode cell-code" id="cb11"><pre class="sourceCode r code-with-copy"><code class="sourceCode r"><span id="cb11-1"><a href="#cb11-1" aria-hidden="true" tabindex="-1"></a><span class="fu">mean</span>(dat<span class="sc">$</span>age.rec, <span class="at">na.rm =</span> <span class="cn">TRUE</span>)</span></code><button title="Copy to Clipboard" class="code-copy-button"><i class="bi"></i></button></pre></div>
<div class="cell-output cell-output-stdout">
<pre><code>[1] 11.64653</code></pre>
</div>
<div class="sourceCode cell-code" id="cb13"><pre class="sourceCode r code-with-copy"><code class="sourceCode r"><span id="cb13-1"><a href="#cb13-1" aria-hidden="true" tabindex="-1"></a><span class="fu">median</span>(dat<span class="sc">$</span>age.rec, <span class="at">na.rm =</span> <span class="cn">TRUE</span>)</span></code><button title="Copy to Clipboard" class="code-copy-button"><i class="bi"></i></button></pre></div>
<div class="cell-output cell-output-stdout">
<pre><code>[1] 13</code></pre>
</div>
</div>
<div class="cell">
<div class="cell-output cell-output-stderr">
<pre><code>Warning: Removed 9 rows containing non-finite outside the scale range
(`stat_density()`).</code></pre>
(`stat_count()`).</code></pre>
</div>
<div class="cell-output-display">
<div>
@ -2363,7 +2431,7 @@ window.Quarto = {
</div>
<div class="cell">
<div class="cell-output cell-output-stderr">
<pre><code>Warning: Removed 2250 rows containing non-finite outside the scale range
<pre><code>Warning: Removed 113 rows containing non-finite outside the scale range
(`stat_boxplot()`).</code></pre>
</div>
<div class="cell-output-display">
@ -2374,22 +2442,22 @@ window.Quarto = {
</div>
</div>
</div>
</section>
<section id="cold-ischemia-time-cold.isc" class="level3" data-number="2.2.4">
<h3 data-number="2.2.4" class="anchored" data-anchor-id="cold-ischemia-time-cold.isc"><span class="header-section-number">2.2.4</span> Cold Ischemia Time <code>cold.isc</code></h3>
<div class="cell">
<div class="sourceCode cell-code" id="cb18"><pre class="sourceCode r code-with-copy"><code class="sourceCode r"><span id="cb18-1"><a href="#cb18-1" aria-hidden="true" tabindex="-1"></a><span class="fu">mean</span>(dat<span class="sc">$</span>cold.isc, <span class="at">na.rm =</span> <span class="cn">TRUE</span>)</span></code><button title="Copy to Clipboard" class="code-copy-button"><i class="bi"></i></button></pre></div>
<div class="cell-output cell-output-stdout">
<pre><code>[1] 10.85967</code></pre>
<div class="cell-output cell-output-stderr">
<pre><code>Warning: Removed 9 rows containing non-finite outside the scale range
(`stat_count()`).</code></pre>
</div>
<div class="cell-output-display">
<div>
<figure class="figure">
<p><img src="slides_files/figure-html/unnamed-chunk-26-1.png" class="img-fluid figure-img" width="672"></p>
</figure>
</div>
<div class="sourceCode cell-code" id="cb20"><pre class="sourceCode r code-with-copy"><code class="sourceCode r"><span id="cb20-1"><a href="#cb20-1" aria-hidden="true" tabindex="-1"></a><span class="fu">median</span>(dat<span class="sc">$</span>cold.isc, <span class="at">na.rm =</span> <span class="cn">TRUE</span>)</span></code><button title="Copy to Clipboard" class="code-copy-button"><i class="bi"></i></button></pre></div>
<div class="cell-output cell-output-stdout">
<pre><code>[1] 7</code></pre>
</div>
</div>
<div class="cell">
<div class="cell-output cell-output-stderr">
<pre><code>Warning: Removed 2250 rows containing non-finite outside the scale range
<pre><code>Warning: Removed 9 rows containing non-finite outside the scale range
(`stat_density()`).</code></pre>
</div>
<div class="cell-output-display">
@ -2403,7 +2471,7 @@ window.Quarto = {
<div class="cell">
<div class="cell-output cell-output-stderr">
<pre><code>Warning: Removed 2250 rows containing non-finite outside the scale range
(`stat_density()`).</code></pre>
(`stat_boxplot()`).</code></pre>
</div>
<div class="cell-output-display">
<div>
@ -2414,10 +2482,69 @@ window.Quarto = {
</div>
</div>
</section>
<section id="cold-ischemia-time-cold.isc" class="level3" data-number="2.2.4">
<h3 data-number="2.2.4" class="anchored" data-anchor-id="cold-ischemia-time-cold.isc"><span class="header-section-number">2.2.4</span> Cold Ischemia Time <code>cold.isc</code></h3>
<div class="cell">
<div class="sourceCode cell-code" id="cb20"><pre class="sourceCode r code-with-copy"><code class="sourceCode r"><span id="cb20-1"><a href="#cb20-1" aria-hidden="true" tabindex="-1"></a><span class="fu">mean</span>(dat<span class="sc">$</span>cold.isc, <span class="at">na.rm =</span> <span class="cn">TRUE</span>)</span></code><button title="Copy to Clipboard" class="code-copy-button"><i class="bi"></i></button></pre></div>
<div class="cell-output cell-output-stdout">
<pre><code>[1] 10.85967</code></pre>
</div>
<div class="sourceCode cell-code" id="cb22"><pre class="sourceCode r code-with-copy"><code class="sourceCode r"><span id="cb22-1"><a href="#cb22-1" aria-hidden="true" tabindex="-1"></a><span class="fu">median</span>(dat<span class="sc">$</span>cold.isc, <span class="at">na.rm =</span> <span class="cn">TRUE</span>)</span></code><button title="Copy to Clipboard" class="code-copy-button"><i class="bi"></i></button></pre></div>
<div class="cell-output cell-output-stdout">
<pre><code>[1] 7</code></pre>
</div>
</div>
<div class="cell">
<div class="cell-output cell-output-stderr">
<pre><code>Warning: Removed 2250 rows containing non-finite outside the scale range
(`stat_density()`).</code></pre>
</div>
<div class="cell-output-display">
<div>
<figure class="figure">
<p><img src="slides_files/figure-html/unnamed-chunk-30-1.png" class="img-fluid figure-img" width="672"></p>
</figure>
</div>
</div>
</div>
<div class="cell">
<div class="cell-output cell-output-stderr">
<pre><code>Warning: Removed 2250 rows containing non-finite outside the scale range
(`stat_density()`).</code></pre>
</div>
<div class="cell-output-display">
<div>
<figure class="figure">
<p><img src="slides_files/figure-html/unnamed-chunk-31-1.png" class="img-fluid figure-img" width="672"></p>
</figure>
</div>
</div>
</div>
<div class="cell">
<div class="cell-output cell-output-stderr">
<pre><code>Warning: Removed 2250 rows containing non-finite outside the scale range
(`stat_density()`).</code></pre>
</div>
<div class="cell-output-display">
<div>
<figure class="figure">
<p><img src="slides_files/figure-html/unnamed-chunk-32-1.png" class="img-fluid figure-img" width="672"></p>
</figure>
</div>
</div>
</div>
</section>
<section id="transplant-type-tx.type" class="level3" data-number="2.2.5">
<h3 data-number="2.2.5" class="anchored" data-anchor-id="transplant-type-tx.type"><span class="header-section-number">2.2.5</span> Transplant Type <code>tx.type</code></h3>
<div class="cell">
<div class="sourceCode cell-code" id="cb24"><pre class="sourceCode r code-with-copy"><code class="sourceCode r"><span id="cb24-1"><a href="#cb24-1" aria-hidden="true" tabindex="-1"></a>dat<span class="sc">$</span>tx.type <span class="sc">|&gt;</span> <span class="fu">table</span>()</span></code><button title="Copy to Clipboard" class="code-copy-button"><i class="bi"></i></button></pre></div>
<div class="cell-output cell-output-stdout">
<pre><code>
Cadaveric Living &lt;NA&gt;
5148 4627 0 </code></pre>
</div>
</div>
<div class="cell">
<div class="sourceCode cell-code" id="cb28"><pre class="sourceCode r code-with-copy"><code class="sourceCode r"><span id="cb28-1"><a href="#cb28-1" aria-hidden="true" tabindex="-1"></a>dat<span class="sc">$</span>tx.type <span class="sc">|&gt;</span> <span class="fu">table</span>()</span></code><button title="Copy to Clipboard" class="code-copy-button"><i class="bi"></i></button></pre></div>
<div class="cell-output cell-output-stdout">
<pre><code>
Cadaveric Living
@ -2428,7 +2555,7 @@ Cadaveric Living
<div class="cell-output-display">
<div>
<figure class="figure">
<p><img src="slides_files/figure-html/unnamed-chunk-30-1.png" class="img-fluid figure-img" width="672"></p>
<p><img src="slides_files/figure-html/unnamed-chunk-35-1.png" class="img-fluid figure-img" width="672"></p>
</figure>
</div>
</div>
@ -2447,7 +2574,7 @@ Cadaveric Living
<div class="cell-output-display">
<div>
<figure class="figure">
<p><img src="slides_files/figure-html/unnamed-chunk-32-1.png" class="img-fluid figure-img" width="672"></p>
<p><img src="slides_files/figure-html/unnamed-chunk-37-1.png" class="img-fluid figure-img" width="672"></p>
</figure>
</div>
</div>
@ -2456,7 +2583,7 @@ Cadaveric Living
<div class="cell-output-display">
<div>
<figure class="figure">
<p><img src="slides_files/figure-html/unnamed-chunk-33-1.png" class="img-fluid figure-img" width="672"></p>
<p><img src="slides_files/figure-html/unnamed-chunk-38-1.png" class="img-fluid figure-img" width="672"></p>
</figure>
</div>
</div>
@ -2465,7 +2592,7 @@ Cadaveric Living
<div class="cell-output-display">
<div>
<figure class="figure">
<p><img src="slides_files/figure-html/unnamed-chunk-34-1.png" class="img-fluid figure-img" width="672"></p>
<p><img src="slides_files/figure-html/unnamed-chunk-39-1.png" class="img-fluid figure-img" width="672"></p>
</figure>
</div>
</div>
@ -2478,7 +2605,7 @@ Cadaveric Living
<div class="cell-output-display">
<div>
<figure class="figure">
<p><img src="slides_files/figure-html/unnamed-chunk-35-1.png" class="img-fluid figure-img" width="672"></p>
<p><img src="slides_files/figure-html/unnamed-chunk-40-1.png" class="img-fluid figure-img" width="672"></p>
</figure>
</div>
</div>
@ -2491,50 +2618,79 @@ Cadaveric Living
<div class="cell-output-display">
<div>
<figure class="figure">
<p><img src="slides_files/figure-html/unnamed-chunk-36-1.png" class="img-fluid figure-img" width="672"></p>
<p><img src="slides_files/figure-html/unnamed-chunk-41-1.png" class="img-fluid figure-img" width="672"></p>
</figure>
</div>
</div>
</div>
</section>
</section>
<section id="overall-kaplan-meier" class="level2" data-number="2.3">
<h2 data-number="2.3" class="anchored" data-anchor-id="overall-kaplan-meier"><span class="header-section-number">2.3</span> Overall Kaplan-Meier</h2>
<section id="kaplan-meier" class="level2" data-number="2.3">
<h2 data-number="2.3" class="anchored" data-anchor-id="kaplan-meier"><span class="header-section-number">2.3</span> Kaplan-Meier</h2>
<section id="overall-l" class="level3" data-number="2.3.1">
<h3 data-number="2.3.1" class="anchored" data-anchor-id="overall-l"><span class="header-section-number">2.3.1</span> Overall (L)</h3>
<div class="cell">
<div class="cell-output cell-output-stdout">
<pre><code>Call: survfit(formula = Surv(follow.up, death) ~ 1, data = dat)
time n.risk n.event survival std.err lower 95% CI upper 95% CI
4 4150 359 0.953 0.00252 0.948 0.958
8 1197 86 0.919 0.00449 0.910 0.928
12 48 20 0.888 0.00867 0.871 0.905</code></pre>
</div>
</div>
<div class="cell">
<div class="cell-output-display">
<div>
<figure class="figure">
<p><img src="slides_files/figure-html/unnamed-chunk-38-1.png" class="img-fluid figure-img" width="672"></p>
<p><img src="slides_files/figure-html/unnamed-chunk-43-1.png" class="img-fluid figure-img" width="672"></p>
</figure>
</div>
</div>
</div>
</section>
<section id="hazard-functions" class="level2" data-number="2.4">
<h2 data-number="2.4" class="anchored" data-anchor-id="hazard-functions"><span class="header-section-number">2.4</span> Hazard Functions</h2>
<section id="tx.type-m" class="level3" data-number="2.3.2">
<h3 data-number="2.3.2" class="anchored" data-anchor-id="tx.type-m"><span class="header-section-number">2.3.2</span> <code>tx.type</code> (M)</h3>
<div class="cell">
<div class="cell-output-display">
<div>
<figure class="figure">
<p><img src="slides_files/figure-html/unnamed-chunk-44-1.png" class="img-fluid figure-img" width="672"></p>
</figure>
</div>
</div>
</div>
</section>
</section>
<section id="cox-model" class="level2" data-number="2.4">
<h2 data-number="2.4" class="anchored" data-anchor-id="cox-model"><span class="header-section-number">2.4</span> Cox Model</h2>
<section id="death-distribution" class="level3" data-number="2.4.1">
<h3 data-number="2.4.1" class="anchored" data-anchor-id="death-distribution"><span class="header-section-number">2.4.1</span> <code>death</code> Distribution (?)</h3>
<div class="cell">
<div class="cell-output-display">
<div>
<figure class="figure">
<p><img src="slides_files/figure-html/unnamed-chunk-40-1.png" class="img-fluid figure-img" width="672"></p>
</figure>
</div>
</div>
</div>
<div class="cell">
<div class="cell-output-display">
<div>
<figure class="figure">
<p><img src="slides_files/figure-html/unnamed-chunk-42-1.png" class="img-fluid figure-img" width="672"></p>
<p><img src="slides_files/figure-html/unnamed-chunk-48-1.png" class="img-fluid figure-img" width="672"></p>
</figure>
</div>
</div>
</div>
</section>
<section id="overall" class="level3" data-number="2.4.2">
<h3 data-number="2.4.2" class="anchored" data-anchor-id="overall"><span class="header-section-number">2.4.2</span> Overall (?)</h3>
<section id="overall-l-1" class="level3" data-number="2.4.2">
<h3 data-number="2.4.2" class="anchored" data-anchor-id="overall-l-1"><span class="header-section-number">2.4.2</span> Overall (L)</h3>
<div class="callout callout-style-default callout-note callout-titled">
<div class="callout-header d-flex align-content-center">
<div class="callout-icon-container">
<i class="callout-icon"></i>
</div>
<div class="callout-title-container flex-fill">
Note
</div>
</div>
<div class="callout-body-container callout-body">
<p>skip overall, jump directly to <code>tx.type</code></p>
</div>
</div>
<div class="cell">
<div class="cell-output cell-output-stdout">
<pre><code># A tibble: 7 × 5
@ -2550,20 +2706,17 @@ Cadaveric Living
</div>
</div>
</section>
<section id="tx.type-m" class="level3" data-number="2.4.3">
<h3 data-number="2.4.3" class="anchored" data-anchor-id="tx.type-m"><span class="header-section-number">2.4.3</span> <code>tx.type</code> (M)</h3>
<section id="tx.type-m-1" class="level3" data-number="2.4.3">
<h3 data-number="2.4.3" class="anchored" data-anchor-id="tx.type-m-1"><span class="header-section-number">2.4.3</span> <code>tx.type</code> (M)</h3>
</section>
<section id="age-continuous-l" class="level3" data-number="2.4.4">
<h3 data-number="2.4.4" class="anchored" data-anchor-id="age-continuous-l"><span class="header-section-number">2.4.4</span> <code>age</code> (continuous) (L)</h3>
</section>
<section id="cox-model" class="level2" data-number="2.5">
<h2 data-number="2.5" class="anchored" data-anchor-id="cox-model"><span class="header-section-number">2.5</span> Cox Model</h2>
<section id="age-continuous-l" class="level3" data-number="2.5.1">
<h3 data-number="2.5.1" class="anchored" data-anchor-id="age-continuous-l"><span class="header-section-number">2.5.1</span> <code>age</code> (continuous) (L)</h3>
<section id="age-categorical-m" class="level3" data-number="2.4.5">
<h3 data-number="2.4.5" class="anchored" data-anchor-id="age-categorical-m"><span class="header-section-number">2.4.5</span> <code>age</code> (categorical) (M)</h3>
</section>
<section id="age-categorical-m" class="level3" data-number="2.5.2">
<h3 data-number="2.5.2" class="anchored" data-anchor-id="age-categorical-m"><span class="header-section-number">2.5.2</span> <code>age</code> (categorical) (M)</h3>
</section>
<section id="full-model-l" class="level3" data-number="2.5.3">
<h3 data-number="2.5.3" class="anchored" data-anchor-id="full-model-l"><span class="header-section-number">2.5.3</span> Full model (L)</h3>
<section id="full-model-l" class="level3" data-number="2.4.6">
<h3 data-number="2.4.6" class="anchored" data-anchor-id="full-model-l"><span class="header-section-number">2.4.6</span> Full model (L)</h3>
<div class="cell">
<div class="cell-output cell-output-stdout">
<pre><code>Call:
@ -2654,12 +2807,12 @@ Score (logrank) test = 69.92 on 13 df, p=8e-10</code></pre>
</div>
</div>
</section>
<section id="discussion-include-year-or-not" class="level3" data-number="2.5.4">
<h3 data-number="2.5.4" class="anchored" data-anchor-id="discussion-include-year-or-not"><span class="header-section-number">2.5.4</span> Discussion: include <code>year</code> or not?</h3>
<section id="discussion-include-year-or-not" class="level3" data-number="2.4.7">
<h3 data-number="2.4.7" class="anchored" data-anchor-id="discussion-include-year-or-not"><span class="header-section-number">2.4.7</span> Discussion: include <code>year</code> or not?</h3>
</section>
</section>
<section id="assumption-testing" class="level2" data-number="2.6">
<h2 data-number="2.6" class="anchored" data-anchor-id="assumption-testing"><span class="header-section-number">2.6</span> Assumption Testing</h2>
<section id="assumption-testing" class="level2" data-number="2.5">
<h2 data-number="2.5" class="anchored" data-anchor-id="assumption-testing"><span class="header-section-number">2.5</span> Assumption Testing</h2>
</section>
</section>
<section id="conclusion-m-l" class="level1" data-number="3">

View file

@ -1,609 +0,0 @@
---
title: Slides
execute:
cache: true
freeze: auto
include: true
echo: false
number-sections: true
---
```{r}
library(tidyverse)
library(dplyr)
library(ggplot2)
library(survival)
library(emmeans)
library(foreign)
library(gtsummary)
library(gt)
library(ggsurvfit)
```
```{r}
dat <- read.csv("./unos.txt", sep = "\t")
names(dat) <- c("hla.match", "age.donor", "age.rec", "cold.isc", "death",
"year", "sex", "tx.type", "follow.up")
dat <- dat |>
mutate(
sex = factor(sex, levels = c(0,1), labels = c("Female","Male")),
tx.type = factor(tx.type, levels = c(0,1), labels = c("Cadaveric","Living")),
hla.match = factor(hla.match),
year = factor(year)
)
```
# Introduction: research question
## Survival after transplantation (M)
## Identify Predictors (M)
## Why Survival Analysis (L)
Motivation: study the distribution of time to event $T$.
Example: time of death after kidney transplant.
```{r}
ex <- data.frame(
id = c(1, 2, 3, 4, 5),
transplant = c(2000, 2000, 2001, 2003, 2004),
death = c(2005, 2009, 2005, 2004, 2016)
)
ex_table_1 <- ex |>
gt() |>
cols_label(
id = "ID",
transplant = "Transplant",
death = "Death"
) %>%
cols_align(align = "center", columns = everything())
ex_plot_real_time <- ggplot(ex) +
geom_segment(aes(x = transplant, xend = death, y = factor(id),
yend = factor(id)), color = "grey50", linewidth = 1) +
geom_point(aes(x = transplant, y = factor(id), color = "trans"), size = 3) +
geom_point(aes(x = death, y = factor(id), color = "death"), size = 3) +
scale_color_manual(values = c("trans" = "#00BFC4", "death" = "#F8766D")) +
scale_y_discrete(limits = rev) +
labs(x = "Year", y = "Subject ID", color = "Event") +
theme_minimal()
```
```{r}
ex_table_1
ex_plot_real_time
```
---
We then calculate time to death for each respondents.
With this, all we need is to fit a linear model `t ~ X` or `log(t) ~ X`
```{r}
ex_t <- ex |>
mutate(
t = death - transplant
)
ex_table_2 <- ex_t |>
gt() |>
cols_label(
id = "ID",
transplant = "Transplant",
death = "Death",
t = "Time to death"
) |>
cols_align(align = "center", columns = everything())
ex_plot_uniform_time <- ggplot(ex_t) +
geom_segment(aes(x = 0, xend = t, y = factor(id),
yend = factor(id)), color = "grey50", linewidth = 1) +
geom_point(aes(x = 0, y = factor(id), color = "trans"), size = 3) +
geom_point(aes(x = t, y = factor(id), color = "death"), size = 3) +
scale_color_manual(values = c("trans" = "#00BFC4", "death" = "#F8766D")) +
scale_y_discrete(limits = rev) +
labs(x = "Year", y = "Subject ID", color = "Event") +
theme_minimal()
```
```{r}
ex_table_2
ex_plot_uniform_time
```
---
What if we do not know when exactly some respondents die?
Scenario 1: the study ends at the year 2008?
```{r}
ex_t_c <- ex_t |>
mutate(
death_censored = if_else(death <= 2008, death, 2008),
death_censored_txt = if_else(death <= 2008, as.character(death), "> 2008"),
status = if_else(death <= 2008, 1, 0),
t_1 = death_censored - transplant,
t_1_txt = if_else(death <= 2008, as.character(t_1),
paste(">", as.character(t_1)))
)
```
```{r}
ex_table_3 <- ex_t_c |>
select(id, transplant, death_censored_txt, t_1_txt) |>
gt() |>
cols_label(
id = "ID",
transplant = "Transplant",
death_censored_txt = "Death",
t_1_txt = "Time to death"
) |>
cols_align(align = "center", columns = everything())
ex_plot_real_time_1 <- ggplot(ex_t_c) +
geom_segment(aes(x = transplant, xend = death_censored, y = factor(id),
yend = factor(id)), color = "grey50", linewidth = 1) +
geom_point(aes(x = transplant, y = factor(id), color = "trans"), size = 3) +
geom_point(aes(x = death_censored, y = factor(id), color =
if_else(status == 1, "death", "censored")), size = 3) +
scale_color_manual(values = c("trans" = "#00BFC4", "death" = "#F8766D",
"censored" = "orange")) +
scale_y_discrete(limits = rev) +
labs(x = "Year", y = "Subject ID", color = "Event") +
xlim(2000, 2016) +
geom_vline(xintercept = 2008, linetype = "dashed", color = "orange",
linewidth = 0.8) +
theme_minimal()
ex_plot_uniform_time_1 <- ggplot(ex_t_c) +
geom_segment(aes(x = 0, xend = t_1, y = factor(id),
yend = factor(id)), color = "grey50", linewidth = 1) +
geom_point(aes(x = 0, y = factor(id), color = "trans"), size = 3) +
geom_point(aes(x = t_1, y = factor(id), color =
if_else(status == 1, "death", "censored")), size = 3) +
scale_color_manual(values = c("trans" = "#00BFC4", "death" = "#F8766D",
"censored" = "orange")) +
scale_y_discrete(limits = rev) +
labs(x = "Year", y = "Subject ID", color = "Event") +
theme_minimal()
```
```{r}
ex_table_3
ex_plot_real_time_1
ex_plot_uniform_time_1
```
**Right Censoring**: only observe the event (death) if it occurs before a
certain time (2008).
---
Scenario 2: respondent 3 move away; loss follow up
```{r}
ex_alt <- ex_t_c
ex_alt$death_censored_txt[3] <- "> 2005"
ex_alt$status[3] <- 0
ex_alt$t_1_txt[3] <- "> 4"
ex_table_4 <- ex_alt |>
select(id, transplant, death_censored_txt, t_1_txt) |>
gt() |>
cols_label(
id = "ID",
transplant = "Transplant",
death_censored_txt = "Death",
t_1_txt = "Time to death"
) |>
cols_align(align = "center", columns = everything())
ex_plot_real_time_2 <- ggplot(ex_alt) +
geom_segment(aes(x = transplant, xend = death_censored, y = factor(id),
yend = factor(id)), color = "grey50", linewidth = 1) +
geom_point(aes(x = transplant, y = factor(id), color = "trans"), size = 3) +
geom_point(aes(x = death_censored, y = factor(id), color =
if_else(status == 1, "death", "censored")), size = 3) +
scale_color_manual(values = c("trans" = "#00BFC4", "death" = "#F8766D",
"censored" = "orange")) +
scale_y_discrete(limits = rev) +
labs(x = "Year", y = "Subject ID", color = "Event") +
xlim(2000, 2016) +
geom_vline(xintercept = 2008, linetype = "dashed", color = "orange",
linewidth = 0.8) +
theme_minimal()
ex_plot_uniform_time_2 <- ggplot(ex_alt) +
geom_segment(aes(x = 0, xend = t_1, y = factor(id),
yend = factor(id)), color = "grey50", linewidth = 1) +
geom_point(aes(x = 0, y = factor(id), color = "trans"), size = 3) +
geom_point(aes(x = t_1, y = factor(id), color =
if_else(status == 1, "death", "censored")), size = 3) +
scale_color_manual(values = c("trans" = "#00BFC4", "death" = "#F8766D",
"censored" = "orange")) +
scale_y_discrete(limits = rev) +
labs(x = "Year", y = "Subject ID", color = "Event") +
theme_minimal()
```
```{r}
ex_table_4
ex_plot_real_time_2
ex_plot_uniform_time_2
```
---
How many patients are right censored?
```{r}
dat |>
mutate(Overall = "Overall") |>
pivot_longer(
cols = c(Overall, sex, tx.type),
names_to = "Attribute",
values_to = "Category"
) |>
count(Attribute, Category, death) |>
ggplot(aes(x = Category, y = n, fill = factor(death))) +
geom_col(position = "dodge") +
facet_wrap(~ Attribute, scales = "free_x") +
labs(x = "Group", y = "Count", fill = "Death Status") +
theme_minimal()
```
## Challenges in Survival Analysis (L)
- **Right Censoring**: only observe the event if it occurs before a certain
time.
- **Left Censoring**: event has occurred prior to the start of a research
- Follow up every 3 years.
- Event has occurred -> event happened sometime before follow up.
- **Left Truncation**: delayed entry; respondents are included only if they
survived long enough.
- Start follow up with patients 100 days after the transplant
- Patients dies within 100 day wouldn't be included in the dataset
- **Right Truncation**: respondents are included only if they have already
experienced the event.
- Retrospective analysis from deceased patients between 1990 and 2000.
- Patients not dead before 2000 are not included in the dataset.
# Method & Result
## Explain Dataset (M)
## Table 1 (L)
### HLA match `hla.match`
```{r}
dat$hla.match |> table(useNA = "always")
```
```{r}
ggplot(dat, aes(x = hla.match)) +
geom_bar() +
labs(x = "HLA match", y = "Count") +
theme_minimal()
```
```{r}
ggplot(dat, aes(x = hla.match, fill = tx.type)) +
geom_bar(position = "dodge") +
labs(x = "HLA match", y = "Count") +
theme_minimal()
```
### Donor age `age.donor`
```{r}
#| echo: true
mean(dat$age.donor, na.rm = TRUE)
median(dat$age.donor, na.rm = TRUE)
```
```{r}
ggplot(dat, aes(x = age.donor)) +
geom_bar() +
labs(x = "Donor Age", y = "Count") +
theme_minimal()
```
```{r}
#| fig-width: 8
#| fig-height: 12
ggplot(dat, aes(x = age.donor)) +
geom_bar() +
labs(x = "Donor Age", y = "Count") +
theme_minimal() +
facet_grid(hla.match ~ .)
```
```{r}
ggplot(dat, aes(x = age.donor, color = hla.match)) +
geom_density() +
labs(x = "Donor Age", y = "Count") +
theme_minimal()
```
### Recipient Age `age.rec`
```{r}
#| echo: true
mean(dat$age.rec, na.rm = TRUE)
median(dat$age.rec, na.rm = TRUE)
```
```{r}
ggplot(dat, aes(x = age.rec)) +
geom_bar() +
labs(x = "Recipient Age", y = "Count") +
theme_minimal()
```
```{r}
ggplot(dat, aes(x = as.factor(age.rec), y = age.donor)) +
geom_boxplot() +
theme_minimal()
```
```{r}
ggplot(dat, aes(x = age.rec, fill = tx.type)) +
geom_bar(position = "dodge") +
theme_minimal()
```
```{r}
ggplot(dat, aes(x = age.rec, color = hla.match)) +
geom_density() +
theme_minimal()
```
```{r}
ggplot(dat, aes(x = as.factor(age.rec), y = cold.isc)) +
geom_boxplot() +
theme_minimal()
```
### Cold Ischemia Time `cold.isc`
```{r}
#| echo: true
mean(dat$cold.isc, na.rm = TRUE)
median(dat$cold.isc, na.rm = TRUE)
```
```{r}
ggplot(dat, aes(x = cold.isc)) +
geom_density() +
labs(x = "Cold Ischemia Time (hours)", y = "Probability Density") +
theme_minimal()
```
```{r}
ggplot(dat, aes(x = cold.isc, color = tx.type, group = tx.type)) +
geom_density() +
labs(x = "Cold Ischemia Time (hours)", y = "Probability Density") +
theme_minimal()
```
### Transplant Type `tx.type`
```{r}
#| echo: true
dat$tx.type |> table()
```
```{r}
ggplot(dat, aes(x = tx.type)) +
geom_bar() +
labs(x = "Transplant Type", y = "Count") +
theme_minimal()
```
### Year `year`
```{r}
dat$year |> table()
```
```{r}
ggplot(dat, aes(x = year)) +
geom_bar() +
labs(x = "Year", y = "Count") +
theme_minimal()
```
```{r}
ggplot(dat, aes(x = year, y = follow.up)) +
geom_boxplot()
```
```{r}
ggplot(dat, aes(x = year, fill = tx.type)) +
geom_bar(position = "dodge")
```
```{r}
ggplot(dat, aes(x = year, y = age.rec)) +
geom_boxplot()
```
```{r}
ggplot(dat, aes(x = year, y = age.donor)) +
geom_boxplot()
```
## Overall Kaplan-Meier
```{r}
km_all <- survfit(Surv(follow.up, death) ~ 1, data = dat)
```
```{r}
km_all |>
ggsurvfit(type = "survival") +
add_confidence_interval() +
scale_y_continuous(limits = c(0, 1), labels = scales::label_percent()) +
labs(
x = "Years of Follow-up",
y = "Overall Survival Probability"
) +
theme_minimal()
```
## Hazard Functions
```{r}
get.life.table <- function(dat, time.intervals) {
n.pop <- nrow(dat)
dat |>
recode.dat(time.intervals) |>
group_by(fu.interval) |>
summarize(
n.censored = sum(.data$death == 0),
n.event = sum(.data$death),
) |>
ungroup() |>
calculate.hazard(n.pop)
}
get.life.table.by.groups <- function(dat, time.intervals, grps) {
grps |>
lapply(function(grp) {
dat |>
get.life.table.by.group(time.intervals, grp) |>
mutate(
grp.name = grp,
grp.value = pick(1)[[1]]
) |>
select(-1)
}) |>
bind_rows()
}
get.life.table.by.group <- function(dat, time.intervals, grp) {
dat |>
recode.dat(time.intervals) |>
group_by(fu.interval, .data[[grp]]) |>
summarize(
n.censored = sum(.data$death == 0),
n.event = sum(.data$death),
.groups = "keep"
) |>
ungroup(fu.interval) |>
group_modify(function(df.sub, grp) {
grp.name <- names(grp)
grp.value <- grp[[1]]
n.pop <- (dat[[grp.name]] == grp.value) |> sum()
calculate.hazard(df.sub, n.pop)
}) |>
ungroup()
}
calculate.hazard <- function(life.table, n.pop) {
n.removed <- life.table$n.event + life.table$n.censored
n.removed.accum <- c(0, cumsum(n.removed)[-length(n.removed)])
life.table |>
mutate(
n.at.risk = n.pop - n.removed.accum,
# TODO: how to account for censored? How do we adjust for uneven interval?
hazard.rate = n.event / n.at.risk
)
}
recode.dat <- function(dat, time.intervals) {
df <- dat[dat$follow.up <= sum(time.intervals), ]
time.points <- cumsum(time.intervals)
df$fu.interval <- sapply(df$follow.up, function(time) {
time.points[time <= time.points][1]
})
df
}
```
### `death` Distribution (?)
```{r}
dat |>
mutate(
accum.death = cumsum(death),
accum.censored = if_else(death == 1, 0, 1) |> cumsum()
) |>
ggplot() +
geom_step(aes(x = follow.up, y = accum.death))
```
```{r}
```
```{r}
plot.death = dat[dat$death == 1,] |>
ggplot(aes(x = follow.up)) +
geom_histogram(bins = 50)
plot.death
```
### Overall (?)
```{r}
time.intervals <- c(1/3, 1/3, 1/3, 1, 1, 1, 1)
get.life.table(dat, time.intervals)
```
### `tx.type` (M)
```{r}
```
## Cox Model
### `age` (continuous) (L)
### `age` (categorical) (M)
### Full model (L)
```{r}
m1 <- coxph(Surv(follow.up, death) ~ hla.match + tx.type, data = dat)
summary(m1)
m2 <- coxph(Surv(follow.up, death) ~ hla.match * tx.type, data = dat)
summary(m2)
anova(m1, m2, test = "LRT")
```
### Discussion: include `year` or not?
## Assumption Testing
# Conclusion (M + L)