Skip to content

Commit def40f8

Browse files
sbalcisbalci
committed
add tableone styles
1 parent 5f18d9f commit def40f8

27 files changed

+902
-251
lines changed

‎DESCRIPTION‎

Lines changed: 10 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,8 @@
11
Type: Package
22
Package: ClinicoPath
33
Title: Analysis for Clinicopathological Research
4-
Version: 0.0.1.0012
5-
Date: 2020-05-08
4+
Version: 0.0.1.0013
5+
Date: 2020-05-13
66
Authors@R:
77
person(given = "Serdar",
88
family = "Balci",
@@ -53,20 +53,25 @@ Imports:
5353
magrittr,
5454
corrr,
5555
correlation,
56-
RVAideMemoire
56+
RVAideMemoire,
57+
plotROC,
58+
arsenal
5759
Remotes:
5860
ddsjoberg/gtsummary,
5961
ndphillips/FFTrees,
6062
easystats/report,
6163
spgarbet/tangram,
62-
cran/rmngb
64+
cran/rmngb,
65+
mixOmicsTeam/mixOmics
6366
Suggests:
6467
circlize,
6568
randomForest,
6669
huxtable,
6770
flextable,
6871
Hmisc,
69-
rmarkdown
72+
rmarkdown,
73+
corpcor,
74+
rARPACK
7075
VignetteBuilder:
7176
knitr
7277
Encoding: UTF-8

‎NAMESPACE‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,7 @@ import(ggplot2)
3131
import(ggstatsplot)
3232
import(gtsummary)
3333
import(jmvcore)
34+
import(plotROC)
3435
import(rmngb)
3536
import(survival)
3637
import(survminer)

‎R/competingsurvival.b.R‎

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,6 @@
11
#' Competing Survival Analysis
22
#'
3-
4-
53
#'
6-
#'
74
#'
85
#' @importFrom R6 R6Class
96
#' @import jmvcore

‎R/competingsurvival.h.R‎

Lines changed: 53 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,11 @@ competingsurvivalOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
88
initialize = function(
99
explanatory = NULL,
1010
overalltime = NULL,
11-
outcome = NULL, ...) {
11+
outcome = NULL,
12+
dod = NULL,
13+
dooc = NULL,
14+
awd = NULL,
15+
awod = NULL, ...) {
1216

1317
super$initialize(
1418
package='ClinicoPath',
@@ -35,22 +39,51 @@ competingsurvivalOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
3539
"outcome",
3640
outcome,
3741
suggested=list(
38-
"continuous"),
42+
"ordinal",
43+
"nominal"),
3944
permitted=list(
40-
"numeric"))
45+
"factor"))
46+
private$..dod <- jmvcore::OptionLevel$new(
47+
"dod",
48+
dod,
49+
variable="(outcome)")
50+
private$..dooc <- jmvcore::OptionLevel$new(
51+
"dooc",
52+
dooc,
53+
variable="(outcome)")
54+
private$..awd <- jmvcore::OptionLevel$new(
55+
"awd",
56+
awd,
57+
variable="(outcome)")
58+
private$..awod <- jmvcore::OptionLevel$new(
59+
"awod",
60+
awod,
61+
variable="(outcome)")
4162

4263
self$.addOption(private$..explanatory)
4364
self$.addOption(private$..overalltime)
4465
self$.addOption(private$..outcome)
66+
self$.addOption(private$..dod)
67+
self$.addOption(private$..dooc)
68+
self$.addOption(private$..awd)
69+
self$.addOption(private$..awod)
4570
}),
4671
active = list(
4772
explanatory = function() private$..explanatory$value,
4873
overalltime = function() private$..overalltime$value,
49-
outcome = function() private$..outcome$value),
74+
outcome = function() private$..outcome$value,
75+
dod = function() private$..dod$value,
76+
dooc = function() private$..dooc$value,
77+
awd = function() private$..awd$value,
78+
awod = function() private$..awod$value),
5079
private = list(
5180
..explanatory = NA,
5281
..overalltime = NA,
53-
..outcome = NA)
82+
..outcome = NA,
83+
..dod = NA,
84+
..dooc = NA,
85+
..awd = NA,
86+
..awod = NA)
5487
)
5588

5689
competingsurvivalResults <- if (requireNamespace('jmvcore')) R6::R6Class(
@@ -110,6 +143,10 @@ competingsurvivalBase <- if (requireNamespace('jmvcore')) R6::R6Class(
110143
#' @param explanatory .
111144
#' @param overalltime .
112145
#' @param outcome .
146+
#' @param dod .
147+
#' @param dooc .
148+
#' @param awd .
149+
#' @param awod .
113150
#' @return A results object containing:
114151
#' \tabular{llllll}{
115152
#' \code{results$todo} \tab \tab \tab \tab \tab a html \cr
@@ -121,7 +158,11 @@ competingsurvival <- function(
121158
data,
122159
explanatory,
123160
overalltime,
124-
outcome) {
161+
outcome,
162+
dod,
163+
dooc,
164+
awd,
165+
awod) {
125166

126167
if ( ! requireNamespace('jmvcore'))
127168
stop('competingsurvival requires jmvcore to be installed (restart may be required)')
@@ -137,11 +178,16 @@ competingsurvival <- function(
137178
`if`( ! missing(outcome), outcome, NULL))
138179

139180
for (v in explanatory) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
181+
for (v in outcome) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
140182

141183
options <- competingsurvivalOptions$new(
142184
explanatory = explanatory,
143185
overalltime = overalltime,
144-
outcome = outcome)
186+
outcome = outcome,
187+
dod = dod,
188+
dooc = dooc,
189+
awd = awd,
190+
awod = awod)
145191

146192
analysis <- competingsurvivalClass$new(
147193
options = options,

‎R/roc.b.R‎

Lines changed: 157 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -1,32 +1,172 @@
11
#' ROC Analysis
22
#'
3-
4-
53
#'
6-
#'
74
#'
85
#' @importFrom R6 R6Class
96
#' @import jmvcore
10-
#'
7+
#' @import ggplot2
8+
#' @import plotROC
119

1210

13-
rocClass <- if (requireNamespace("jmvcore")) R6::R6Class("rocClass", inherit = rocBase,
11+
rocClass <- if (requireNamespace("jmvcore")) R6::R6Class("rocClass", inherit = rocBase,
1412
private = list(.run = function() {
15-
16-
17-
13+
14+
15+
1816
# TODO
19-
17+
2018
todo <- glue::glue("This Module is still under development
2119
-
2220
-
2321
")
24-
22+
2523
self$results$todo$setContent(todo)
26-
27-
28-
if (nrow(self$data) == 0) stop("Data contains no (complete) rows")
29-
30-
31-
32-
}))
24+
25+
26+
# if (nrow(self$data) == 0) stop("Data contains no (complete) rows")
27+
28+
# plotROC
29+
#
30+
# http://sachsmc.github.io/plotROC/
31+
32+
33+
set.seed(2529)
34+
D.ex <- rbinom(200, size = 1, prob = .5)
35+
M1 <- rnorm(200, mean = D.ex, sd = .65)
36+
M2 <- rnorm(200, mean = D.ex, sd = 1.5)
37+
38+
plotData <- data.frame(D = D.ex,
39+
D.str = c("Healthy", "Ill")[D.ex + 1],
40+
M1 = M1,
41+
M2 = M2,
42+
stringsAsFactors = FALSE)
43+
44+
45+
46+
# Prepare plot data
47+
48+
image <- self$results$plot
49+
image$setState(plotData)
50+
51+
52+
plot3 <- private$.plot2()
53+
54+
self$results$plot3$setContent(plot3)
55+
56+
57+
58+
59+
60+
},
61+
62+
.plot=function(image, ...) {
63+
64+
plotData <- image$state
65+
66+
67+
set.seed(2529)
68+
D.ex <- rbinom(200, size = 1, prob = .5)
69+
M1 <- rnorm(200, mean = D.ex, sd = .65)
70+
M2 <- rnorm(200, mean = D.ex, sd = 1.5)
71+
72+
plotData <- data.frame(D = D.ex,
73+
D.str = c("Healthy", "Ill")[D.ex + 1],
74+
M1 = M1,
75+
M2 = M2,
76+
stringsAsFactors = FALSE)
77+
78+
plot <- plotData %>%
79+
ggplot2::ggplot(.,
80+
ggplot2::aes(d = D, m = M1)
81+
) +
82+
plotROC::geom_roc(
83+
labels = TRUE,
84+
n.cuts = 5,
85+
labelsize = 5,
86+
labelround = 2
87+
) +
88+
plotROC::style_roc(
89+
theme = theme_grey,
90+
xlab = "1 - Specificity"
91+
) +
92+
plotROC::geom_rocci(
93+
sig.level = .01,
94+
ci.at = quantile(M1, c(.1, .4, .5, .6, .9))
95+
)
96+
97+
98+
99+
plotROC::direct_label(
100+
ggroc_p = plot,
101+
labels = "Biomarker",
102+
label.angle = 45,
103+
nudge_x = 0,
104+
nudge_y = -.1,
105+
size = 6
106+
) +
107+
plotROC::style_roc()
108+
109+
110+
111+
print(plot)
112+
TRUE
113+
} ,
114+
115+
.plot2=function() {
116+
117+
# plotData <- image$state
118+
119+
120+
set.seed(2529)
121+
D.ex <- rbinom(200, size = 1, prob = .5)
122+
M1 <- rnorm(200, mean = D.ex, sd = .65)
123+
M2 <- rnorm(200, mean = D.ex, sd = 1.5)
124+
125+
plotData <- data.frame(D = D.ex,
126+
D.str = c("Healthy", "Ill")[D.ex + 1],
127+
M1 = M1,
128+
M2 = M2,
129+
stringsAsFactors = FALSE)
130+
131+
plot2 <- plotData %>%
132+
ggplot2::ggplot(.,
133+
ggplot2::aes(d = D, m = M1)
134+
) +
135+
plotROC::geom_roc()
136+
137+
138+
# Interactive Plots
139+
140+
plot2 <- plotROC::plot_interactive_roc(plot2)
141+
# opens in new html
142+
143+
144+
# plot2 <- plotROC::export_interactive_roc(plot2)
145+
# no output
146+
147+
148+
# plot2 <- cat(plotROC::export_interactive_roc(plot2))
149+
# no output
150+
151+
knitr::asis_output(plot2)
152+
}
153+
154+
# Multiple ROC Curves
155+
# http://sachsmc.github.io/plotROC/
156+
157+
# New Features
158+
159+
# Advanced Options
160+
161+
162+
)
163+
)
164+
165+
166+
167+
168+
# Other ROC Packages on CRAN
169+
#
170+
# AROC: Covariate-Adjusted Receiver Operating Characteristic Curve Inference
171+
# https://cran.r-project.org/web/packages/AROC/index.html
172+

‎R/roc.h.R‎

Lines changed: 18 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -57,7 +57,9 @@ rocResults <- if (requireNamespace('jmvcore')) R6::R6Class(
5757
inherit = jmvcore::Group,
5858
active = list(
5959
todo = function() private$.items[["todo"]],
60-
text = function() private$.items[["text"]]),
60+
text = function() private$.items[["text"]],
61+
plot = function() private$.items[["plot"]],
62+
plot3 = function() private$.items[["plot3"]]),
6163
private = list(),
6264
public=list(
6365
initialize=function(options) {
@@ -72,7 +74,19 @@ rocResults <- if (requireNamespace('jmvcore')) R6::R6Class(
7274
self$add(jmvcore::Preformatted$new(
7375
options=options,
7476
name="text",
75-
title="ROC"))}))
77+
title="ROC"))
78+
self$add(jmvcore::Image$new(
79+
options=options,
80+
title="ROC",
81+
name="plot",
82+
width=600,
83+
height=450,
84+
renderFun=".plot",
85+
requiresData=TRUE))
86+
self$add(jmvcore::Html$new(
87+
options=options,
88+
title="ROC Interactive",
89+
name="plot3"))}))
7690

7791
rocBase <- if (requireNamespace('jmvcore')) R6::R6Class(
7892
"rocBase",
@@ -111,6 +125,8 @@ rocBase <- if (requireNamespace('jmvcore')) R6::R6Class(
111125
#' \tabular{llllll}{
112126
#' \code{results$todo} \tab \tab \tab \tab \tab a html \cr
113127
#' \code{results$text} \tab \tab \tab \tab \tab a preformatted \cr
128+
#' \code{results$plot} \tab \tab \tab \tab \tab an image \cr
129+
#' \code{results$plot3} \tab \tab \tab \tab \tab a html \cr
114130
#' }
115131
#'
116132
#' @export

0 commit comments

Comments
 (0)