Toolbox

library(stRoke)

A toolbox

My own toolbox in my small workshop is a mix of some old, worn, well proven tools and some newcomers. This package should be seen as something like that.

I have tried to collect tools and functions from other packages that I use regularly in addition to functions that I have written myself to fill use cases, that I have not been able to find solutions to elsewhere.

CPR manipulations

Note that, if handled, CPR numbers (social security numbers) should be handled with care as they a considered highly sensitive data.

The CPR number is structured as DDMMYY-XXXX, with the 1st X designating decade of birth, the last X designate binary gender (not biological sex) dependent on even/uneven as female/male, and the last for digits are used in a modulus calculation to verify the validity of the CPR number. Foreigners and unidentified persons are given temporary CPR numbers including letters.

More information can be found on cpr.dk.

Note, that all CPR numbers used in examples are publicly known or non-organic.

age_calc()

The age_calc() function was created as a learning exercise and functions similarly to lubridate::time_length().

(age <- age_calc(as.Date("1945-10-23"), as.Date("2018-09-30")))
#> [1] 72.93699
trunc(age)
#> [1] 72

cpr_check()

Checks validity of CPR numbers according to the modulus 11 rule. Note that due to limitations in the possible available CPR numbers, this rule does not apply to all CPR numbers after 2007.

cpr_check(
  c(
    "2310450637",
    "010190-2000",
    "010115-4000",
    "300450-1030",
    "010150-4021",
    "010150-4AA1"
  )
)
#> OBS: as per 2007 not all valid CPR numbers apply to modulus 11 rule.
#>     
#> See the vignette 'Toolbox'
#> Warning in matrix(as.numeric(unlist(strsplit(cpr_short, ""))), nrow = 10): NAs
#> introduced by coercion
#> [1]  TRUE FALSE FALSE FALSE FALSE    NA

Including CPR numbers with letters gives a warning and NA, as it can not be checked by the modulus 11 function. Should be used with care, see the message.

cpr_dob()

Extracts date of birth (DOB) from a CPR number. Accounts for the decade of birth. See earlier.

cpr_dob(c(
  "2310450637",
  "010190-2000",
  "010115-4000",
  "300450-1030",
  "010150-4021"
))
#> [1] "23-10-1945" "01-01-1990" "01-01-2015" "30-04-1950" "01-01-1950"

cpr_female()

Gives logical vector of whether female gender from last digit of CPR.

table(cpr_female(stRoke::cprs[, 1]))
#> 
#> FALSE  TRUE 
#>    98   102

Plotting

ci_plot()

Plots odds ratios with 95 % confidence intervals. Performs binary logistic regression for outcome factors with two (2) levels and ordinal logistic regression for outcome factors with more than two levels. Mind relevant assumptions.

Outputs ggplot element for further manipulation.

data(talos)
talos[, "mrs_1"] <- factor(talos[, "mrs_1"], ordered = TRUE)
ci_plot(
  ds = talos,
  x = "rtreat",
  y = "mrs_1",
  vars = c("hypertension", "diabetes")
)
#> Waiting for profiling to be done...

generic_stroke()

For learning purposes. Uses anonymized data from the TALOS trial to output a Table 1 (with gtsummary::tbl_summary()), plotting the so-called grotta-bars based on mRS scores (with rankinPlot::grottaBar()) and a ordinal logistic regression model plot (with stRoke::ci_plot()).

generic_stroke(stRoke::talos,
               "rtreat",
               "mrs_6",
               variables = c("hypertension", "diabetes", "civil"))
#> Waiting for profiling to be done...
#> $`Table 1`
#> <div id="ypncyqsmzn" style="padding-left:0px;padding-right:0px;padding-top:10px;padding-bottom:10px;overflow-x:auto;overflow-y:auto;width:auto;height:auto;">
#>   <style>#ypncyqsmzn table {
#>   font-family: system-ui, 'Segoe UI', Roboto, Helvetica, Arial, sans-serif, 'Apple Color Emoji', 'Segoe UI Emoji', 'Segoe UI Symbol', 'Noto Color Emoji';
#>   -webkit-font-smoothing: antialiased;
#>   -moz-osx-font-smoothing: grayscale;
#> }
#> 
#> #ypncyqsmzn thead, #ypncyqsmzn tbody, #ypncyqsmzn tfoot, #ypncyqsmzn tr, #ypncyqsmzn td, #ypncyqsmzn th {
#>   border-style: none;
#> }
#> 
#> #ypncyqsmzn p {
#>   margin: 0;
#>   padding: 0;
#> }
#> 
#> #ypncyqsmzn .gt_table {
#>   display: table;
#>   border-collapse: collapse;
#>   line-height: normal;
#>   margin-left: auto;
#>   margin-right: auto;
#>   color: #333333;
#>   font-size: 16px;
#>   font-weight: normal;
#>   font-style: normal;
#>   background-color: #FFFFFF;
#>   width: auto;
#>   border-top-style: solid;
#>   border-top-width: 2px;
#>   border-top-color: #A8A8A8;
#>   border-right-style: none;
#>   border-right-width: 2px;
#>   border-right-color: #D3D3D3;
#>   border-bottom-style: solid;
#>   border-bottom-width: 2px;
#>   border-bottom-color: #A8A8A8;
#>   border-left-style: none;
#>   border-left-width: 2px;
#>   border-left-color: #D3D3D3;
#> }
#> 
#> #ypncyqsmzn .gt_caption {
#>   padding-top: 4px;
#>   padding-bottom: 4px;
#> }
#> 
#> #ypncyqsmzn .gt_title {
#>   color: #333333;
#>   font-size: 125%;
#>   font-weight: initial;
#>   padding-top: 4px;
#>   padding-bottom: 4px;
#>   padding-left: 5px;
#>   padding-right: 5px;
#>   border-bottom-color: #FFFFFF;
#>   border-bottom-width: 0;
#> }
#> 
#> #ypncyqsmzn .gt_subtitle {
#>   color: #333333;
#>   font-size: 85%;
#>   font-weight: initial;
#>   padding-top: 3px;
#>   padding-bottom: 5px;
#>   padding-left: 5px;
#>   padding-right: 5px;
#>   border-top-color: #FFFFFF;
#>   border-top-width: 0;
#> }
#> 
#> #ypncyqsmzn .gt_heading {
#>   background-color: #FFFFFF;
#>   text-align: center;
#>   border-bottom-color: #FFFFFF;
#>   border-left-style: none;
#>   border-left-width: 1px;
#>   border-left-color: #D3D3D3;
#>   border-right-style: none;
#>   border-right-width: 1px;
#>   border-right-color: #D3D3D3;
#> }
#> 
#> #ypncyqsmzn .gt_bottom_border {
#>   border-bottom-style: solid;
#>   border-bottom-width: 2px;
#>   border-bottom-color: #D3D3D3;
#> }
#> 
#> #ypncyqsmzn .gt_col_headings {
#>   border-top-style: solid;
#>   border-top-width: 2px;
#>   border-top-color: #D3D3D3;
#>   border-bottom-style: solid;
#>   border-bottom-width: 2px;
#>   border-bottom-color: #D3D3D3;
#>   border-left-style: none;
#>   border-left-width: 1px;
#>   border-left-color: #D3D3D3;
#>   border-right-style: none;
#>   border-right-width: 1px;
#>   border-right-color: #D3D3D3;
#> }
#> 
#> #ypncyqsmzn .gt_col_heading {
#>   color: #333333;
#>   background-color: #FFFFFF;
#>   font-size: 100%;
#>   font-weight: normal;
#>   text-transform: inherit;
#>   border-left-style: none;
#>   border-left-width: 1px;
#>   border-left-color: #D3D3D3;
#>   border-right-style: none;
#>   border-right-width: 1px;
#>   border-right-color: #D3D3D3;
#>   vertical-align: bottom;
#>   padding-top: 5px;
#>   padding-bottom: 6px;
#>   padding-left: 5px;
#>   padding-right: 5px;
#>   overflow-x: hidden;
#> }
#> 
#> #ypncyqsmzn .gt_column_spanner_outer {
#>   color: #333333;
#>   background-color: #FFFFFF;
#>   font-size: 100%;
#>   font-weight: normal;
#>   text-transform: inherit;
#>   padding-top: 0;
#>   padding-bottom: 0;
#>   padding-left: 4px;
#>   padding-right: 4px;
#> }
#> 
#> #ypncyqsmzn .gt_column_spanner_outer:first-child {
#>   padding-left: 0;
#> }
#> 
#> #ypncyqsmzn .gt_column_spanner_outer:last-child {
#>   padding-right: 0;
#> }
#> 
#> #ypncyqsmzn .gt_column_spanner {
#>   border-bottom-style: solid;
#>   border-bottom-width: 2px;
#>   border-bottom-color: #D3D3D3;
#>   vertical-align: bottom;
#>   padding-top: 5px;
#>   padding-bottom: 5px;
#>   overflow-x: hidden;
#>   display: inline-block;
#>   width: 100%;
#> }
#> 
#> #ypncyqsmzn .gt_spanner_row {
#>   border-bottom-style: hidden;
#> }
#> 
#> #ypncyqsmzn .gt_group_heading {
#>   padding-top: 8px;
#>   padding-bottom: 8px;
#>   padding-left: 5px;
#>   padding-right: 5px;
#>   color: #333333;
#>   background-color: #FFFFFF;
#>   font-size: 100%;
#>   font-weight: initial;
#>   text-transform: inherit;
#>   border-top-style: solid;
#>   border-top-width: 2px;
#>   border-top-color: #D3D3D3;
#>   border-bottom-style: solid;
#>   border-bottom-width: 2px;
#>   border-bottom-color: #D3D3D3;
#>   border-left-style: none;
#>   border-left-width: 1px;
#>   border-left-color: #D3D3D3;
#>   border-right-style: none;
#>   border-right-width: 1px;
#>   border-right-color: #D3D3D3;
#>   vertical-align: middle;
#>   text-align: left;
#> }
#> 
#> #ypncyqsmzn .gt_empty_group_heading {
#>   padding: 0.5px;
#>   color: #333333;
#>   background-color: #FFFFFF;
#>   font-size: 100%;
#>   font-weight: initial;
#>   border-top-style: solid;
#>   border-top-width: 2px;
#>   border-top-color: #D3D3D3;
#>   border-bottom-style: solid;
#>   border-bottom-width: 2px;
#>   border-bottom-color: #D3D3D3;
#>   vertical-align: middle;
#> }
#> 
#> #ypncyqsmzn .gt_from_md > :first-child {
#>   margin-top: 0;
#> }
#> 
#> #ypncyqsmzn .gt_from_md > :last-child {
#>   margin-bottom: 0;
#> }
#> 
#> #ypncyqsmzn .gt_row {
#>   padding-top: 8px;
#>   padding-bottom: 8px;
#>   padding-left: 5px;
#>   padding-right: 5px;
#>   margin: 10px;
#>   border-top-style: solid;
#>   border-top-width: 1px;
#>   border-top-color: #D3D3D3;
#>   border-left-style: none;
#>   border-left-width: 1px;
#>   border-left-color: #D3D3D3;
#>   border-right-style: none;
#>   border-right-width: 1px;
#>   border-right-color: #D3D3D3;
#>   vertical-align: middle;
#>   overflow-x: hidden;
#> }
#> 
#> #ypncyqsmzn .gt_stub {
#>   color: #333333;
#>   background-color: #FFFFFF;
#>   font-size: 100%;
#>   font-weight: initial;
#>   text-transform: inherit;
#>   border-right-style: solid;
#>   border-right-width: 2px;
#>   border-right-color: #D3D3D3;
#>   padding-left: 5px;
#>   padding-right: 5px;
#> }
#> 
#> #ypncyqsmzn .gt_stub_row_group {
#>   color: #333333;
#>   background-color: #FFFFFF;
#>   font-size: 100%;
#>   font-weight: initial;
#>   text-transform: inherit;
#>   border-right-style: solid;
#>   border-right-width: 2px;
#>   border-right-color: #D3D3D3;
#>   padding-left: 5px;
#>   padding-right: 5px;
#>   vertical-align: top;
#> }
#> 
#> #ypncyqsmzn .gt_row_group_first td {
#>   border-top-width: 2px;
#> }
#> 
#> #ypncyqsmzn .gt_row_group_first th {
#>   border-top-width: 2px;
#> }
#> 
#> #ypncyqsmzn .gt_summary_row {
#>   color: #333333;
#>   background-color: #FFFFFF;
#>   text-transform: inherit;
#>   padding-top: 8px;
#>   padding-bottom: 8px;
#>   padding-left: 5px;
#>   padding-right: 5px;
#> }
#> 
#> #ypncyqsmzn .gt_first_summary_row {
#>   border-top-style: solid;
#>   border-top-color: #D3D3D3;
#> }
#> 
#> #ypncyqsmzn .gt_first_summary_row.thick {
#>   border-top-width: 2px;
#> }
#> 
#> #ypncyqsmzn .gt_last_summary_row {
#>   padding-top: 8px;
#>   padding-bottom: 8px;
#>   padding-left: 5px;
#>   padding-right: 5px;
#>   border-bottom-style: solid;
#>   border-bottom-width: 2px;
#>   border-bottom-color: #D3D3D3;
#> }
#> 
#> #ypncyqsmzn .gt_grand_summary_row {
#>   color: #333333;
#>   background-color: #FFFFFF;
#>   text-transform: inherit;
#>   padding-top: 8px;
#>   padding-bottom: 8px;
#>   padding-left: 5px;
#>   padding-right: 5px;
#> }
#> 
#> #ypncyqsmzn .gt_first_grand_summary_row {
#>   padding-top: 8px;
#>   padding-bottom: 8px;
#>   padding-left: 5px;
#>   padding-right: 5px;
#>   border-top-style: double;
#>   border-top-width: 6px;
#>   border-top-color: #D3D3D3;
#> }
#> 
#> #ypncyqsmzn .gt_last_grand_summary_row_top {
#>   padding-top: 8px;
#>   padding-bottom: 8px;
#>   padding-left: 5px;
#>   padding-right: 5px;
#>   border-bottom-style: double;
#>   border-bottom-width: 6px;
#>   border-bottom-color: #D3D3D3;
#> }
#> 
#> #ypncyqsmzn .gt_striped {
#>   background-color: rgba(128, 128, 128, 0.05);
#> }
#> 
#> #ypncyqsmzn .gt_table_body {
#>   border-top-style: solid;
#>   border-top-width: 2px;
#>   border-top-color: #D3D3D3;
#>   border-bottom-style: solid;
#>   border-bottom-width: 2px;
#>   border-bottom-color: #D3D3D3;
#> }
#> 
#> #ypncyqsmzn .gt_footnotes {
#>   color: #333333;
#>   background-color: #FFFFFF;
#>   border-bottom-style: none;
#>   border-bottom-width: 2px;
#>   border-bottom-color: #D3D3D3;
#>   border-left-style: none;
#>   border-left-width: 2px;
#>   border-left-color: #D3D3D3;
#>   border-right-style: none;
#>   border-right-width: 2px;
#>   border-right-color: #D3D3D3;
#> }
#> 
#> #ypncyqsmzn .gt_footnote {
#>   margin: 0px;
#>   font-size: 90%;
#>   padding-top: 4px;
#>   padding-bottom: 4px;
#>   padding-left: 5px;
#>   padding-right: 5px;
#> }
#> 
#> #ypncyqsmzn .gt_sourcenotes {
#>   color: #333333;
#>   background-color: #FFFFFF;
#>   border-bottom-style: none;
#>   border-bottom-width: 2px;
#>   border-bottom-color: #D3D3D3;
#>   border-left-style: none;
#>   border-left-width: 2px;
#>   border-left-color: #D3D3D3;
#>   border-right-style: none;
#>   border-right-width: 2px;
#>   border-right-color: #D3D3D3;
#> }
#> 
#> #ypncyqsmzn .gt_sourcenote {
#>   font-size: 90%;
#>   padding-top: 4px;
#>   padding-bottom: 4px;
#>   padding-left: 5px;
#>   padding-right: 5px;
#> }
#> 
#> #ypncyqsmzn .gt_left {
#>   text-align: left;
#> }
#> 
#> #ypncyqsmzn .gt_center {
#>   text-align: center;
#> }
#> 
#> #ypncyqsmzn .gt_right {
#>   text-align: right;
#>   font-variant-numeric: tabular-nums;
#> }
#> 
#> #ypncyqsmzn .gt_font_normal {
#>   font-weight: normal;
#> }
#> 
#> #ypncyqsmzn .gt_font_bold {
#>   font-weight: bold;
#> }
#> 
#> #ypncyqsmzn .gt_font_italic {
#>   font-style: italic;
#> }
#> 
#> #ypncyqsmzn .gt_super {
#>   font-size: 65%;
#> }
#> 
#> #ypncyqsmzn .gt_footnote_marks {
#>   font-size: 75%;
#>   vertical-align: 0.4em;
#>   position: initial;
#> }
#> 
#> #ypncyqsmzn .gt_asterisk {
#>   font-size: 100%;
#>   vertical-align: 0;
#> }
#> 
#> #ypncyqsmzn .gt_indent_1 {
#>   text-indent: 5px;
#> }
#> 
#> #ypncyqsmzn .gt_indent_2 {
#>   text-indent: 10px;
#> }
#> 
#> #ypncyqsmzn .gt_indent_3 {
#>   text-indent: 15px;
#> }
#> 
#> #ypncyqsmzn .gt_indent_4 {
#>   text-indent: 20px;
#> }
#> 
#> #ypncyqsmzn .gt_indent_5 {
#>   text-indent: 25px;
#> }
#> 
#> #ypncyqsmzn .katex-display {
#>   display: inline-flex !important;
#>   margin-bottom: 0.75em !important;
#> }
#> 
#> #ypncyqsmzn div.Reactable > div.rt-table > div.rt-thead > div.rt-tr.rt-tr-group-header > div.rt-th-group:after {
#>   height: 0px !important;
#> }
#> </style>
#>   <table class="gt_table" data-quarto-disable-processing="false" data-quarto-bootstrap="false">
#>   <thead>
#>     <tr class="gt_col_headings">
#>       <th class="gt_col_heading gt_columns_bottom_border gt_left" rowspan="1" colspan="1" scope="col" id="label"><span class='gt_from_md'><strong>Characteristic</strong></span></th>
#>       <th class="gt_col_heading gt_columns_bottom_border gt_center" rowspan="1" colspan="1" scope="col" id="stat_0"><span class='gt_from_md'><strong>Overall</strong><br />
#> N = 200</span><span class="gt_footnote_marks" style="white-space:nowrap;font-style:italic;font-weight:normal;line-height:0;"><sup>1</sup></span></th>
#>       <th class="gt_col_heading gt_columns_bottom_border gt_center" rowspan="1" colspan="1" scope="col" id="stat_1"><span class='gt_from_md'><strong>Active</strong><br />
#> N = 79</span><span class="gt_footnote_marks" style="white-space:nowrap;font-style:italic;font-weight:normal;line-height:0;"><sup>1</sup></span></th>
#>       <th class="gt_col_heading gt_columns_bottom_border gt_center" rowspan="1" colspan="1" scope="col" id="stat_2"><span class='gt_from_md'><strong>Placebo</strong><br />
#> N = 121</span><span class="gt_footnote_marks" style="white-space:nowrap;font-style:italic;font-weight:normal;line-height:0;"><sup>1</sup></span></th>
#>     </tr>
#>   </thead>
#>   <tbody class="gt_table_body">
#>     <tr><td headers="label" class="gt_row gt_left">hypertension</td>
#> <td headers="stat_0" class="gt_row gt_center">101 (51%)</td>
#> <td headers="stat_1" class="gt_row gt_center">38 (48%)</td>
#> <td headers="stat_2" class="gt_row gt_center">63 (52%)</td></tr>
#>     <tr><td headers="label" class="gt_row gt_left">diabetes</td>
#> <td headers="stat_0" class="gt_row gt_center">23 (12%)</td>
#> <td headers="stat_1" class="gt_row gt_center">9 (11%)</td>
#> <td headers="stat_2" class="gt_row gt_center">14 (12%)</td></tr>
#>     <tr><td headers="label" class="gt_row gt_left">civil</td>
#> <td headers="stat_0" class="gt_row gt_center"><br /></td>
#> <td headers="stat_1" class="gt_row gt_center"><br /></td>
#> <td headers="stat_2" class="gt_row gt_center"><br /></td></tr>
#>     <tr><td headers="label" class="gt_row gt_left">    alone</td>
#> <td headers="stat_0" class="gt_row gt_center">59 (30%)</td>
#> <td headers="stat_1" class="gt_row gt_center">22 (28%)</td>
#> <td headers="stat_2" class="gt_row gt_center">37 (31%)</td></tr>
#>     <tr><td headers="label" class="gt_row gt_left">    partner</td>
#> <td headers="stat_0" class="gt_row gt_center">141 (71%)</td>
#> <td headers="stat_1" class="gt_row gt_center">57 (72%)</td>
#> <td headers="stat_2" class="gt_row gt_center">84 (69%)</td></tr>
#>   </tbody>
#>   
#>   <tfoot class="gt_footnotes">
#>     <tr>
#>       <td class="gt_footnote" colspan="4"><span class="gt_footnote_marks" style="white-space:nowrap;font-style:italic;font-weight:normal;line-height:0;"><sup>1</sup></span> <span class='gt_from_md'>n (%)</span></td>
#>     </tr>
#>   </tfoot>
#> </table>
#> </div>
#> 
#> $`Figure 1`

#> 
#> $`Figure 2`

index_plot()

Used for plotting scores from a multi dimensional patient test.

index_plot(stRoke::score[score$event == "A", ])

win_prob()

The win_prob() is an implementation of the Tournament Method for calculating the probability of winning as suggested by Zou et al 2022. The authors has included a spreadsheet as supplementary materials. This function aims to mimic that functionality. The function also includes a print() extension for nice printing.

win_prob(
  data = stRoke::talos,
  response = "mrs_6",
  group = "rtreat",
  sample.size = TRUE,
  print.tables = TRUE
)
#>   Zou et al's winP (doi: 10.1161/STROKEAHA.121.037744) 
#> 
#> Probability of a random observation in Placebo group 
#>       will have a higher response score than a random
#>       observation in Active group:
#> 
#>         winP: 0.400 (0.612, 0.372)      p=0.0125
#> --------------------------------------------
#> 
#> The numbers needed to treat (NNT) are: -9
#> 
#> 
#> --------------------------------------------
#> 
#>  With Active/Placebo ratio = 1 and beta = 0.2
#>               the sample size needed is: 238
#> 
#> 
#> --------------------------------------------
#> 
#> Results for the Active group:
#>  |mrs_6 | Freq|  prop| overall_rank| rank| win_frac|
#>      |:-----|----:|-----:|------------:|----:|--------:|
#>      |0     |   14| 0.177|        175.0| 72.5|    0.847|
#>      |1     |   29| 0.367|        113.5| 51.0|    0.517|
#>      |2     |   22| 0.278|         49.0| 25.5|    0.194|
#>      |3     |    9| 0.114|         15.0| 10.0|    0.041|
#>      |4     |    3| 0.038|          7.0|  4.0|    0.025|
#>      |6     |    2| 0.025|          2.5|  1.5|    0.008|
#> 
#> Results for the Placebo group:
#>  |mrs_6 | Freq|  prop| overall_rank|  rank| win_frac|
#>      |:-----|----:|-----:|------------:|-----:|--------:|
#>      |0     |   37| 0.306|        175.0| 103.0|    0.911|
#>      |1     |   43| 0.355|        113.5|  63.0|    0.639|
#>      |2     |   35| 0.289|         49.0|  24.0|    0.316|
#>      |3     |    2| 0.017|         15.0|   5.5|    0.120|
#>      |4     |    2| 0.017|          7.0|   3.5|    0.044|
#>      |6     |    2| 0.017|          2.5|   1.5|    0.013|