- Package: stRoke
- Optimisation of functions
- Visualising clinical data
2022-09-27
## function (x) ## { ## last <- as.integer(substr(x, start = 11, stop = 11)) ## sex <- ifelse(last%%2 == 0, "female", "male") ## return(sex) ## } ## <bytecode: 0x7fbbfd192940> ## <environment: namespace:daDoctoR>
## function(cpr){ ## if (!is.vector(cpr)) stop("Input has to be vector") ## ## x <- nchar(as.character(cpr)) # Formats as character to avoid confusions ## ## as.integer(substr(cpr, start = x, stop = x)) %% 2 == 0 ## } ## <bytecode: 0x7fbbf90131b0> ## <environment: namespace:stRoke>
fsd<-sample(c("231045-0637", "010115-4000", "0101896000","010189-3000", "300450-1030","010150-4021"), size = 100, replace = T) microbenchmark::microbenchmark( stRoke::cpr_female(fsd), daDoctoR::cpr_sex(fsd))
## Unit: microseconds ## expr min lq mean median uq max ## stRoke::cpr_female(fsd) 118.917 119.8340 121.9624 120.5010 122.563 147.459 ## daDoctoR::cpr_sex(fsd) 130.043 132.0005 136.7349 133.0425 137.522 265.959 ## neval ## 100 ## 100
## function (cpr) ## { ## v <- c() ## for (x in cpr) { ## if (!substr(x, 7, 7) %in% c("-", ".")) { ## x <- paste(substr(x, 1, 6), substr(x, 7, 10), collapse = "-") ## } ## p1 <- as.integer(substr(x, 1, 1)) ## p2 <- as.integer(substr(x, 2, 2)) ## p3 <- as.integer(substr(x, 3, 3)) ## p4 <- as.integer(substr(x, 4, 4)) ## p5 <- as.integer(substr(x, 5, 5)) ## p6 <- as.integer(substr(x, 6, 6)) ## p7 <- as.integer(substr(x, 8, 8)) ## p8 <- as.integer(substr(x, 9, 9)) ## p9 <- as.integer(substr(x, 10, 10)) ## p10 <- as.integer(substr(x, 11, 11)) ## v <- c(v, ifelse((p1 * 4 + p2 * 3 + p3 * 2 + p4 * 7 + ## p5 * 6 + p6 * 5 + p7 * 4 + p8 * 3 + p9 * 2 + p10)%%11 == ## 0, "valid", "invalid")) ## } ## return(v) ## } ## <bytecode: 0x7fbbda4ad798> ## <environment: namespace:daDoctoR>
## function(cpr){ ## # Check validity of CPR number, format ddmmyy-xxxx ## # Build upon data from this document: https://cpr.dk/media/12066/personnummeret-i-cpr.pdf ## ## OBS according to new description, not all valid CPR numbers apply to this modulus 11 rule. ## message( ## "OBS: according to new description, not all valid CPR numbers apply to this modulus 11 rule. ## Please refer to: https://cpr.dk/media/12066/personnummeret-i-cpr.pdf") ## ## str_length <- nchar(cpr) ## # Calculating length of each element in vector ## ## cpr_short <- paste0(substr(cpr,1,6),substr(cpr,str_length-3,str_length)) ## # Subsetting strings to first 6 and last 4 characters to short format cpr. ## ## cpr_matrix <- matrix(as.numeric(unlist(strsplit(cpr_short,""))),nrow=10) ## # Splitting all strings by each character to list, unlisting and creating matrix. Default is by column. ## ## test_vector <- c(4,3,2,7,6,5,4,3,2,1) ## # Multiplication vector from https://cpr.dk/media/12066/personnummeret-i-cpr.pdf ## ## colSums(cpr_matrix*test_vector) %% 11 == 0 ## # Testing if modulus 11 == 0 of sums of matrix * multiplication vector. ## } ## <bytecode: 0x7fbbda514f10> ## <environment: namespace:stRoke>
microbenchmark::microbenchmark( stRoke::cpr_check(fsd), daDoctoR::cpr_check(fsd))
## Unit: microseconds ## expr min lq mean median uq ## stRoke::cpr_check(fsd) 670.084 680.980 731.0385 695.688 722.4385 ## daDoctoR::cpr_check(fsd) 1940.126 1975.605 2079.1628 1997.605 2055.0005 ## max neval ## 2571.167 100 ## 4228.084 100
library(gtsummary) theme_gtsummary_compact() tbl_summary(df, by = "sex") |> add_overall()
Characteristic | Overall, N = 6221 | female, N = 2321 | male, N = 3901 |
---|---|---|---|
mfi_gen_bin_1 | 351 (56%) | 152 (66%) | 199 (51%) |
mfi_phys_bin_1 | 322 (52%) | 136 (59%) | 186 (48%) |
mfi_men_bin_1 | 163 (26%) | 63 (27%) | 100 (26%) |
mfi_mot_bin_1 | 136 (22%) | 55 (24%) | 81 (21%) |
mfi_act_bin_1 | 334 (54%) | 125 (54%) | 209 (54%) |
who5_cut_1 | 178 (29%) | 75 (32%) | 103 (26%) |
mdi_bin_1 | 34 (5.5%) | 16 (6.9%) | 18 (4.6%) |
diabetes | 58 (9.3%) | 16 (6.9%) | 42 (11%) |
hypertension | 328 (53%) | 123 (53%) | 205 (53%) |
1 n (%) |
cs <- viridis::viridis_pal(alpha = .2, begin = 0, end = 1, direction = 1, option = "D") p <- plot(eulerr::euler(df|>transmute("General fatigue" = mfi_gen_bin_1, "Decreased wellbeing" = who5_cut_1, "Depressive symptoms" = mdi_bin_1), shape="ellipse"), quantities = TRUE, fill = cs, lty = 1:3, labels = list(font = 4))
colnames(df)[1:5]<-c("general","physical","mental","motivation","activity") fs <- list() ls <- levels(factor(df$sex)) for (i in seq_along(ls)){ fs[[i]] <- eulerr::euler(df|>filter(sex==ls[i])|>select(1:5),shape="ellipse") names(fs)[i]<-ls[i] }
ps<-list() for (i in seq_along(ls)){ ps[[i]] <- plot(fs[[i]], quantities = TRUE, fill = cs, lty = 1:5, labels = list(font = 4)) names(ps)[i]<-ls[i] }
plot_grid(ps[[1]],ps[[2]],ncol=2,labels=ls)
remotes::install_github(“agdamsbo/stRoke”)