version 23.1.7

DESCRIPTION

@@ -0,0 +1,35 @@
+Package: stRoke
+Title: Clinical Stroke Research
+Version: 23.1.7
+Authors@R: 
+    person("Andreas Gammelgaard", "Damsbo", , "agdamsbo@clin.au.dk", role = c("aut", "cre"),
+           comment = c(ORCID = "0000-0002-7559-1154"))
+Description: This is an R-toolbox of custom functions for convenient data management 
+    and analysis in clinical health research and teaching.
+    The package is mainly collected for personal use, but any use beyond that is encouraged.
+    This package has migrated functions from 'agdamsbo/daDoctoR', and new functions has been added.
+    Version follows months and year. See NEWS/Changelog for release notes.
+    This package includes sampled data from the TALOS trial (Kraglund et al (2018) <doi:10.1161/STROKEAHA.117.020067>).
+    The win_prob() function is based on work by Zou et al (2022) <doi:10.1161/STROKEAHA.121.037744>.
+    The age_calc() function is based on work by Becker (2020) <doi:10.18637/jss.v093.i02>.
+URL: https://agdamsbo.github.io/stRoke/,
+        https://github.com/agdamsbo/stRoke
+BugReports: https://github.com/agdamsbo/stRoke/issues
+License: GPL-3
+Encoding: UTF-8
+RoxygenNote: 7.2.3
+LazyData: true
+Suggests: knitr, rmarkdown, spelling, testthat (>= 3.0.0)
+Language: en-US
+Config/testthat/edition: 3
+Imports: dplyr, ggplot2, gtsummary, MASS, rankinPlot, stats, tidyr,
+        utils
+Depends: R (>= 3.5.0)
+VignetteBuilder: knitr
+NeedsCompilation: no
+Packaged: 2023-01-23 11:27:19 UTC; au301842
+Author: Andreas Gammelgaard Damsbo [aut, cre]
+    (<https://orcid.org/0000-0002-7559-1154>)
+Maintainer: Andreas Gammelgaard Damsbo <agdamsbo@clin.au.dk>
+Repository: CRAN
+Date/Publication: 2023-01-24 10:20:09 UTC

MD5

@@ -0,0 +1,57 @@
+47f15cfdff668788a3e898ac57675aac *DESCRIPTION
+7610a3017230808ab528fd9f26ffa0a3 *NAMESPACE
+7c79981794b064658c960ada4d7a89df *NEWS.md
+7b12e6054953e69ede6dfeb21fd2dda1 *R/age_calc.R
+e7133c8b257426831bea708d83619057 *R/ci_plot.R
+93ca852adc3e1b7e1e466ee51edd717a *R/cpr_tools.R
+e9209d22d107e54924be938da834c788 *R/cprs.R
+a7e98448a47fab58d2d76cd9b0dc9969 *R/files_filter.R
+ae37e84d3850ef76aa7c82d31d005796 *R/generic_stroke.R
+7d15d855a6a7068b49aff59fae2941e8 *R/index_plot.R
+7b6138eec394ab668a284626d56f2133 *R/label_select.R
+2057eec351a220bedea2f37add95c783 *R/quantile_cut.R
+357e9c2bc328a76401f8f03b1e891b09 *R/score.R
+c59c97259b127f78899cd409f6b66be7 *R/source_lines.R
+df6cc46bc7fae1a55b713f3d5065b35a *R/stRoke-package.R
+115a60cc61179b8046fdcdc68caa5afe *R/talos.R
+a52e3d5ec69970334fa670ade52a9230 *R/win_prob.R
+13b51128fb783569d501ad5802a076c7 *README.md
+0c6ad5b3446721162c89589e8077ab1c *build/partial.rdb
+1f92ccb09034d426227aefb018737632 *build/vignette.rds
+9ff58f51afe4d7a525d9fbd96d2a0254 *data/cprs.rda
+bef9db1e7fcce7320034d5594439af9b *data/score.rda
+563b9b9a9ce471dad2a1b7c5bdfcb2d9 *data/talos.rda
+7197bb8346f154e92f89e2d97a66db67 *inst/WORDLIST
+294f93b2e947f77154822473e86f1d3a *inst/doc/toolbox.R
+f295cfd4bc7bfd5ca9d4d52c9f12cafd *inst/doc/toolbox.Rmd
+147e99956c4767337d5c9a7a99a6771f *inst/doc/toolbox.html
+d3c74a54cf1e8f7eacce7d01259dea2b *man/age_calc.Rd
+82df41f1b8a28ff9bb9b4138daa40cb6 *man/ci_plot.Rd
+eadee44e4377d87ebc8eeff7ac3b76ce *man/cpr_check.Rd
+182764319c56d018d0e54ca1d4f65fa5 *man/cpr_dob.Rd
+e4f04600cde865c099c59e21bb32b93a *man/cpr_female.Rd
+318a77f6652b3efc9a5b4254ed72c90b *man/cprs.Rd
+c6b600284cc4227cd8feb2d223d395c1 *man/figures/hexlogo.png
+48c49fc24d336ed677c0ba7fd84cac70 *man/files_filter.Rd
+2f72665c2bab7c6cea3899c422293349 *man/generic_stroke.Rd
+720709ce457adced4dae83541dce5794 *man/index_plot.Rd
+53e8f164511dc83958d0f36fce739161 *man/label_select.Rd
+8b410ddb2248c3daadc0a87426fa9689 *man/quantile_cut.Rd
+e06b445017e33cd6b71fd53729574963 *man/score.Rd
+fc3061ff8205ce6cb6c986497c511126 *man/source_lines.Rd
+7b8ca1a8b10c337e6c9643c6bdd52f67 *man/stRoke-package.Rd
+44da65e3085bd5535c23c6696c41ae8c *man/talos.Rd
+a00b1635783d2370dfec1bda36b93f54 *man/win_prob.Rd
+0622a97a2aaa3c342f09636052c2d7f5 *tests/spelling.R
+08ad1c74a6a5f7c7b475e81a91603cb9 *tests/testthat.R
+3dc66050789e019cf7f2976e0920d595 *tests/testthat/test-age_calc.R
+c0f46e97cca78288e01a6d6649feb062 *tests/testthat/test-ci_plot.R
+578042a909ee54b84365732273fcf8ed *tests/testthat/test-cpr_tools.R
+868d1b4dbf9459348df84331d8227ecd *tests/testthat/test-files_filter.R
+1adb7329ca6529d764aa753d3d7e76d4 *tests/testthat/test-generic_stroke.R
+950a332b0980fa3300b44d7e63d0609b *tests/testthat/test-index_plot.R
+713ece9e8f35122a9b2dc0898a52461c *tests/testthat/test-label_select.R
+75a469448993e4f045c66eaf9aa4c681 *tests/testthat/test-quantile_cut.R
+401d9442b7825e668d7595250befaddc *tests/testthat/test-source_lines.R
+6ca37a1f7de78af8fca45971cc503c34 *tests/testthat/test-win_prob.R
+f295cfd4bc7bfd5ca9d4d52c9f12cafd *vignettes/toolbox.Rmd

NAMESPACE

@@ -0,0 +1,36 @@
+# Generated by roxygen2: do not edit by hand
+
+export(age_calc)
+export(ci_plot)
+export(cpr_check)
+export(cpr_dob)
+export(cpr_female)
+export(files_filter)
+export(generic_stroke)
+export(index_plot)
+export(label_select)
+export(quantile_cut)
+export(source_lines)
+export(win_prob)
+import(ggplot2)
+import(utils)
+importFrom(MASS,polr)
+importFrom(dplyr,mutate)
+importFrom(dplyr,select)
+importFrom(gtsummary,add_overall)
+importFrom(gtsummary,tbl_summary)
+importFrom(rankinPlot,grottaBar)
+importFrom(stats,as.formula)
+importFrom(stats,binomial)
+importFrom(stats,coef)
+importFrom(stats,confint)
+importFrom(stats,glm)
+importFrom(stats,lm)
+importFrom(stats,pnorm)
+importFrom(stats,qnorm)
+importFrom(stats,quantile)
+importFrom(stats,reorder)
+importFrom(stats,xtabs)
+importFrom(tidyr,all_of)
+importFrom(tidyr,ends_with)
+importFrom(tidyr,pivot_longer)

NEWS.md

@@ -0,0 +1,79 @@
+# stRoke 23.1.7
+
+### Functions:
+
+* redcap_read_tables() has been removed from the package for now. Looking to add it back later as a minimal data acquisition tool.
+
+# stRoke 23.1.6 - failed due to dependencies
+
+### New attempt at CRAN submission
+
+### Functions:
+
+* win_prop() added to implement the suggested methods in [DOI: 10.1161/STROKEAHA.121.037744](https://doi.org/10.1161/STROKEAHA.121.037744), as an implementation of "Tournament Methods" also found in `library(genodds)`. The function is based on the spreadsheet provided by the authors. A print.win_Prop is also added for printing.
+
+### Notes:
+
+* 23.1.5 failed on CRAN due to gt_plot(). This function has been dropped. Find it as as_ggplot() elsewhere.
+* agdamsbo/REDCapRITS added as "Additional_repositories".
+* Included references listed as authors.
+
+# stRoke 23.1.5
+
+### RELEASE ON CRAN - failed
+
+# stRoke 0.23.1.4
+
+### Functions:
+
+* plot_olr() has been deprecated and removed. 
+* ci_plot() functionality extended to include logistic model plotting.
+* age_calc() use vapply() instead of sapply()
+* gt_plot() function added to plot gt elements as ggplots. From [bstfun](https://github.com/MSKCC-Epi-Bio/bstfun). Not all done and satisfied with the layout with patchwork.
+
+### Documentation
+
+* Trying to complete all flags from goodpractice and inteRgrate
+
+# stRoke 0.23.1.3
+
+### Functions:
+
+* files_filter() added. Simple function to get file names in path with specified filter.
+* updated cpr_dob to give warnings if format is not recognised and return NAs.
+* ci_plot() updated to actually handle binary factors. Uses glm(), not lm().
+
+### Documentation:
+
+* test, test and tests to satisfy codecov and, of course, ensure higher quality
+* changes to comply with goodpractices::gp()
+
+...and probably some more.
+
+# stRoke 0.23.1.2
+
+### Functions:
+
+* cpr_dob() now includes `format=`.
+* Other minor updates.
+
+### Documentation:
+
+* Two new vignettes
+* Taking last steps in documenting before releasing on CRAN
+
+### Other:
+
+* New hex logo
+
+# stRoke 0.23.1.1
+
+### Functions:
+
+* age_calc() now also outputs a numeric vector for units="days", and not a character vector as difftime() would.
+
+### Documentation:
+
+* Added a `NEWS.md` file to track changes to the package.
+* Added codecov
+* Added tests with the help of gpttools

R/age_calc.R

@@ -0,0 +1,124 @@
+#' Calculate age in years, months, or days
+#' 
+#' @param dob Date of birth
+#' @param enddate End date for age calculation (default is Sys.Date())
+#' @param units Units for age calculation (default is "years"). 
+#'              Can be c("days", "months", "years")
+#' @param precise Option to calculate age precisely (default is TRUE)
+#' @return numeric vector length 1
+#' @export
+#' 
+#' @examples
+#' trunc(age_calc(as.Date("1945-10-23"),as.Date("2018-09-30")))
+#' 
+#' @references 
+#' Becker, J.P. (2020). eeptools: An R Package for Teaching and Learning 
+#' Ecology and Evolutionary Biology. Journal of Statistical Software, 
+#' 93(2), 1-27.
+#' @source \doi{10.18637/jss.v093.i02}
+#' 
+#' @keywords date time age
+
+age_calc<-function (dob, enddate = Sys.Date(), units = "years", precise = TRUE)
+{
+  if (!inherits(dob, "Date") | !inherits(enddate, "Date")) {
+    stop("Both dob and enddate must be Date class objects")
+  }
+
+  if (length(dob)==1 && enddate < dob) {
+    stop("End date must be a date after date of birth")
+  }
+
+  if (length(dob)>1 && any(enddate < dob)) {
+    stop("End date must be a date after date of birth")
+  }
+
+  start <- as.POSIXlt(dob)
+  end <- as.POSIXlt(enddate)
+
+  if (precise) {
+    start_is_leap <- ifelse(start$year%%400 == 0, TRUE, 
+                            ifelse(start$year%%100 == 0, 
+                                   FALSE, 
+                                   ifelse(start$year%%4 == 0, TRUE, FALSE)))
+    end_is_leap <- ifelse(end$year%%400 == 0, TRUE, 
+                          ifelse(end$year%%100 == 0, 
+                                 FALSE, 
+                                 ifelse(end$year%%4 == 0, TRUE, FALSE)))
+  }
+  if (units == "days") {
+    result <- as.numeric(difftime(end, start, units = "days"))
+  }
+  else if (units == "months") {
+    months <- vapply(
+      mapply(
+        seq,
+        as.POSIXct(start),
+        as.POSIXct(end),
+        by = "months",
+        SIMPLIFY = FALSE
+      ),
+      length,
+      numeric(1)
+    ) - 1
+
+
+
+    if (precise) {
+      month_length_end <- ifelse(end$mon == 1 & end_is_leap,
+                                 29, ifelse(end$mon == 1, 28,
+                                            ifelse(end$mon %in% c(3, 5, 8, 10),
+                                                   30, 31)))
+      month_length_prior <- ifelse((end$mon - 1) == 1 &
+                                     start_is_leap, 29, 
+                                   ifelse((end$mon - 1) == 1, 28, 
+                                          ifelse((end$mon - 1) %in% 
+                                                   c(3, 5, 8, 10), 30, 31)))
+      month_frac <- ifelse(end$mday > start$mday, 
+                           (end$mday - start$mday)/month_length_end, 
+                           ifelse(end$mday < start$mday, 
+                                  (month_length_prior - 
+                                     start$mday)/month_length_prior + 
+                                    end$mday/month_length_end, 0))
+      result <- months + month_frac
+    }
+    else {
+      result <- months
+    }
+  }
+  else if (units == "years") {
+    years <- vapply(
+      mapply(
+        seq,
+        as.POSIXct(start),
+        as.POSIXct(end),
+        by = "years",
+        SIMPLIFY = FALSE
+      ),
+      length,
+      numeric(1)
+    ) - 1
+    if (precise) {
+      start_length <- ifelse(start_is_leap, 366, 365)
+      end_length <- ifelse(end_is_leap, 366, 365)
+      start_day <- ifelse(start_is_leap & start$yday >=
+                            60, start$yday - 1, start$yday)
+      end_day <- ifelse(end_is_leap & end$yday >= 60, end$yday -
+                          1, end$yday)
+      year_frac <- ifelse(start_day < 
+                            end_day, (end_day - start_day)/end_length, 
+                          ifelse(start_day > end_day,
+                                 (start_length - start_day)/start_length + 
+                                   end_day/end_length, 0))
+      result <- years + year_frac
+    }
+    else {
+      result <- years
+    }
+  }
+
+  else {
+    stop("Unrecognized units. Please choose years, months, or days.")
+  }
+  result
+}