-
Notifications
You must be signed in to change notification settings - Fork 0
/
app.R
389 lines (374 loc) · 13.9 KB
/
app.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
# Method comparison with zlog values - RShiny Web-App
## Packages
if (!require("pacman")) install.packages("pacman"); library(pacman)
pacman::p_load(here) # I prefer this for easier file access
pacman::p_load(shiny)
pacman::p_load(ggplot2) # shiny needs ggplot2
pacman::p_load(mcr)
## User Interface
ui <- fluidPage(
h3("Adler Medical Data Science - Method comparison using zlog-values"),
# navigation bar layout
sidebarLayout(
sidebarPanel(width = 2,
fileInput("File", "Choose file:", multiple = FALSE, accept = c("text/csv", "text/comma-separated-values,text/plain",".csv", ".xls", ".xlsx", ".ods")),
# radioButtons("Sep", "Column separator", choices = c(Komma = ",", Semikolon = ";"), selected = ";"), # not needed anymore (since rio is smart ;)
tags$hr(),
textInput("Method1", "Name of old method:", ""),
textInput("Method2", "Name of new method:", ""),
textInput("Name", "Name of parameter:", ""),
textInput("Unit", "Unit:", ""),
tags$hr(),
"Only for documentation if printed:",
tags$br(),
tags$br(),
textInput("NameUser1", "Name of user:", value = ""),
textInput("Sign1", "Signature of user:", value = ""),
tags$hr(),
tags$br(),
tags$strong("Copyright by Jakob Adler")
#downloadButton("DownloadReport1", "Download Auswertung")
),
mainPanel(
tabsetPanel(
tabPanel("Introduction",
tags$br(),
h4("Dear user,"),
"This is a RShiny-based Web-App for method comparison in the clinical laboratory.
The basic functions for method comparison are using the", tags$strong("mcr-Package"), ".",
tags$br(),
tags$br(),
"In this Web-App we implemented a new approach, which is using zlog-values to bring method comparison closer
to the clinical interpretation. The theoretical basis for zlog-values, published by G. Hoffmann, F. Klawonn,
R. Lichtinghagen and M. Orth can be found under the following link:",
tags$br(),
tags$br(),
uiOutput("Link"),
tags$hr(),
h4("Notes on usage of this Web-App"),
"After uploading a file for the method comparison you can take a look at your data using the tab", tags$strong("Imported data"), ".",
tags$br(),
tags$br(),
"Using the tab", tags$strong("Regression"), ", this app will give you the opportunity to choose the columns of your dataset and
to choose your preferred regression method.",
tags$br(),
tags$br(),
"The", tags$strong("Coefficients"), "tab will give you some information about the correlation coefficent, the determination
coefficent and the variation coefficient. Further it will estimate a correlation test and will give you a summary of
the differences between the measurements.",
tags$br(),
tags$br(),
"The", tags$strong("Bland-Altman-Plot"), "tab shows the classic Bland-Altman-Plot for your method comparison.",
tags$br(),
tags$br(),
"The last two tabs", tags$strong("Zlog-Plot"), "and", tags$strong("Deming regression using zlog-values"), "will show you
a plot of the zlog-values to compare the measured values in relation to their reference intervals to get more information
for the clinical interpretation of your method comparison and it will perform a Deming-regression using the zlog-values of
the measured values.",
tags$br(),
tags$br(),
"I hope, this little Web-App will make future method comparisons easier for you and contribute to a better interpretation
of such method comparisons in the clinical laboratory.",
tags$hr(),
"For critics and questions, please contact", tags$strong("Jakob Adler:"),
tags$br(),
tags$br(),
uiOutput("Link2"),
tags$br(),
tags$strong("Copyright by Jakob Adler")
),
tabPanel("Imported data",
fluidRow(
h4("This table shows the imported data:"),
column(6, dataTableOutput("Cleaned"))
),
tags$br(),
tags$strong("Copyright by Jakob Adler")
),
tabPanel("Regression",
tags$br(),
fluidRow(
uiOutput("Colold")
),
fluidRow(
uiOutput("Colnew"),
),
fluidRow(
radioButtons("Method", "Select regression method:", c("Linear regression" = "Linear", "Deming regression" = "Deming",
"Passing-Bablock regression" = "Passing"))
),
fluidRow(
column(10, plotOutput("RegPlot"))
),
tags$br(),
tags$strong("Copyright by Jakob Adler")
),
tabPanel("Coefficients",
tags$br(),
"Correlation coefficient:",
fluidRow(
column(6, verbatimTextOutput("CorCoeff"))
),
tags$br(),
"Results of correlation test:",
fluidRow(
column(6, verbatimTextOutput("CorTest"))
),
tags$br(),
"Determination coefficient:",
fluidRow(
column(6, verbatimTextOutput("DetCoeff"))
),
tags$br(),
"Summary of the differences between new and old method:",
fluidRow(
column(6, verbatimTextOutput("DiffSumm"))
),
tags$br(),
"Variation coefficient (%):",
fluidRow(
column(6, verbatimTextOutput("VarCoeff"))
),
tags$br(),
tags$strong("Copyright by Jakob Adler")
),
tabPanel("Bland-Altman-Plot",
tags$br(),
fluidRow(
column(10, plotOutput("BlandPlot"))
),
tags$br(),
tags$strong("Copyright by Jakob Adler")
),
tabPanel("Zlog-Plot",
tags$br(),
inputPanel(
numericInput("LL1", "Lower limit old method:", value = NULL),
numericInput("UL1", "Upper limit old method:", value = NULL),
numericInput("LL2", "Lower limit old method:", value = NULL),
numericInput("UL2", "Upper limit old method:", value = NULL)
),
tags$br(),
"Zlog-Plot to compare measured values in relation to their reference intervals:",
fluidRow(
column(12, plotOutput("ZlogPlot"))
),
tags$br(),
tags$strong("Copyright by Jakob Adler")
),
tabPanel("Deming regression using zlog-values",
tags$br(),
fluidRow(
column(12, plotOutput("ZlogRegPlot"))
),
tags$br(),
tags$strong("Copyright by Jakob Adler")
)
)
)
)
)
## Server
server <- function(input, output){
# Link
output$Link <- renderUI({
url <- a("The zlog value as a basis for the standardization of laboratory results", href = "https://www.degruyter.com/document/doi/10.1515/labmed-2017-0135/html")
tagList(url)
})
# Link2
output$Link2 <- renderUI({
url <- a("Adler Medical Data Science on GitHub", href = "https://github.com/Bussard91")
tagList(url)
})
# File upload
output$Cleaned <- renderDataTable({
req(input$File)
tryCatch(
{
df <- rio::import(input$File$datapath, header = T)
df
},
error = function(e) {
stop(safeError(e))
}
)
})
# Rendering dropdown for selection of columns from dataset
output$Colold <- renderUI({
req(input$File)
tryCatch(
{
df <- rio::import(input$File$datapath, header = T)
if (is.null(df)) return("The data frame is empty.")
selectInput("Coldropold", "Select column for old method:", names(df))
},
error = function(e) {
stop(safeError(e))
}
)
})
output$Colnew <- renderUI({
req(input$File)
tryCatch(
{
df <- rio::import(input$File$datapath, header = T)
if (is.null(df)) return("The data frame is empty.")
selectInput("Coldropnew", "Select column for new method:", names(df))
},
error = function(e) {
stop(safeError(e))
}
)
})
# Regression plot
output$RegPlot <- renderPlot({
req(input$File)
tryCatch({
df <- rio::import(input$File$datapath, header = T)
MethodChoosed <- switch(input$Method, "Linear" = "WLinReg", "Deming" = "Deming", "Passing" = "PaBa")
Model <- mcreg(df[,input$Coldropold], df[,input$Coldropnew], method.reg = MethodChoosed)
xaxis <- paste(input$Name, "old method (", input$Unit, ")")
yaxis <- paste(input$Name, "new method (", input$Unit, ")")
title1 <- paste("Method comparison", input$Name)
Regplot1 <- MCResult.plot(Model, x.lab = xaxis, y.lab = yaxis, main = title1)
Regplot1
},
error = function(e){
stop(safeError(e))
})
}, height = 800)
# Statistics
## Correlation coefficient
output$CorCoeff <- renderPrint({
req(input$File)
tryCatch({
df <- rio::import(input$File$datapath, header = T)
cor(df[,input$Coldropold], df[,input$Coldropnew])
},
error = function(e){
stop(safeError(e))
})
})
## Correlation test:
output$CorTest <- renderPrint({
req(input$File)
tryCatch({
df <- rio::import(input$File$datapath, header = T)
cor.test(df[,input$Coldropold], df[,input$Coldropnew])
},
error = function(e){
stop(safeError(e))
})
})
## Determination coefficient
output$DetCoeff <- renderPrint({
req(input$File)
tryCatch({
df <- rio::import(input$File$datapath, header = T)
Deter <- cor(df[,input$Coldropold], df[,input$Coldropnew])
Deter^2
},
error = function(e){
stop(safeError(e))
})
})
## Summary of differences
output$DiffSumm <- renderPrint({
req(input$File)
tryCatch({
df <- rio::import(input$File$datapath, header = T)
df$difference <- df[,input$Coldropnew] - df[,input$Coldropold]
summary(df$difference)
},
error = function(e){
stop(safeError(e))
})
})
## Variation coefficient
output$VarCoeff <- renderPrint({
req(input$File)
tryCatch({
df <- rio::import(input$File$datapath, header = T)
df$differenceperc <- ((df[,input$Coldropnew])*100)/df[,input$Coldropold]
VC <- (sd(df$differenceperc)*100/mean(df$differenceperc))
VC
},
error = function(e){
stop(safeError(e))
})
})
## Bland-Altman-plot
output$BlandPlot <- renderPlot({
req(input$File)
tryCatch({
df <- rio::import(input$File$datapath, header = T)
MethodChoosed <- switch(input$Method, "Linear" = "WLinReg", "Deming" = "Deming", "Passing" = "PaBa")
Model2 <- mcreg(df[,input$Coldropold], df[,input$Coldropnew], method.reg = MethodChoosed)
title2 <- paste("Bland-Altman-Plot", input$Name)
BlandPlot <- MCResult.plotDifference(Model2, main = title2)
BlandPlot
},
error = function(e){
stop(safeError(e))
})
}, height = 800)
# Method comparison using zlog-values
## Zlog-Plot
output$ZlogPlot <- renderPlot({
req(input$File)
tryCatch({
df <- rio::import(input$File$datapath, header = T)
zlog.old <- function(x){
zlogvalue.old <- (log(x) - (log(input$LL1) + log(input$UL1))/2) * (3.92 / (log(input$UL1) - log(input$LL1)))
return(round(zlogvalue.old,2))
}
df$zlog.old2 <- sapply(df[,input$Coldropold], zlog.old)
zlog.new <- function(x){
zlogvalue.new <- (log(x) - (log(input$LL2) + log(input$UL2))/2) * (3.92 / (log(input$UL2) - log(input$LL2)))
return(round(zlogvalue.new,2))
}
df$zlog.new2 <- sapply(df[,input$Coldropnew], zlog.new)
df$Index <- seq(from = 1, to = length(df[,input$Coldropold]), by = 1)
plot(df$Index, df$zlog.old2, pch = 16, col = "blue",
main = paste("Zlog-values as an expression of the deviation in standard deviations", input$Name), xlab = "Measuring pair",
ylab = paste("zlog-value", input$Name), ylim = c(-10, 10), las = T)
points(df$zlog.new2, pch = 16, col = "red")
abline(h = 1.96, lwd = 2)
abline(h = -1.96, lwd = 2)
text(df$zlog.old2, labels = rownames(df), pos = 4)
text(df$zlog.new2, labels = rownames(df), pos = 4)
legend(x = 1, y = -8, legend = c("old method", "new method"), col = c("blue", "red"), pch = 16, cex = 1.2)
},
error = function(e){
stop(safeError(e))
})
}, height = 800)
## Zlog-regression-plot
output$ZlogRegPlot <- renderPlot({
req(input$File)
tryCatch({
df <- rio::import(input$File$datapath, header = T)
zlog.old <- function(x){
zlogvalue.old <- (log(x) - (log(input$LL1) + log(input$UL1))/2) * (3.92 / (log(input$UL1) - log(input$LL1)))
return(round(zlogvalue.old,2))
}
df$zlog.old3 <- sapply(df[,input$Coldropold], zlog.old)
zlog.new <- function(x){
zlogvalue.new <- (log(x) - (log(input$LL2) + log(input$UL2))/2) * (3.92 / (log(input$UL2) - log(input$LL2)))
return(round(zlogvalue.new,2))
}
df$zlog.new3 <- sapply(df[,input$Coldropnew], zlog.new)
df$Index <- seq(from = 1, to = length(df[,input$Coldropold]), by = 1)
Model3 <- mcreg(df$zlog.old3, df$zlog.new3, method.reg = "Deming")
xaxis <- paste(input$Name, "old method (", input$Unit, ")")
yaxis <- paste(input$Name, "new method (", input$Unit, ")")
title1 <- paste("Method comparison", input$Name, "zlog-values")
Regplot2 <- MCResult.plot(Model3, x.lab = xaxis, y.lab = yaxis, main = title1)
Regplot2
},
error = function(e){
stop(safeError(e))
})
}, height = 800)
}
shinyApp(ui = ui, server = server)