Skip to content

Commit 95189e1

Browse files
author
Jan Červený
committed
Update to secure new dplyr package compatibility
There has been change in dplyr package in handling of summarize_each function data type. Now summarize_all should be used.
1 parent ec57cf7 commit 95189e1

2 files changed

Lines changed: 293 additions & 141 deletions

File tree

‎server.R‎

Lines changed: 134 additions & 59 deletions
Original file line numberDiff line numberDiff line change
@@ -7,11 +7,14 @@
77
options( shiny.maxRequestSize = 12 * 1024 ^ 2 )
88
options( java.parameters = "-Xmx4g" )
99

10-
library(shiny)
10+
library(data.table)
11+
library(DT)
1112
library(dplyr)
1213
library(dtplyr)
13-
library(tidyr)
1414
library(mongolite)
15+
library(shiny)
16+
library(shinyBS)
17+
library(tidyr)
1518
library(xlsx)
1619

1720
source("mlabDB-connect.R", echo = FALSE)
@@ -21,22 +24,26 @@ shinyServer(function(input, output, session) {
2124
mLab$insert(
2225
data.frame(
2326
Sys.Date(),
24-
"User",
27+
'User',
2528
input$name,
2629
input$surname,
2730
input$email,
2831
input$organization,
2932
input$department
3033
)
3134
)
32-
updateActionButton(session, "send",
33-
label = "Successfully Sent!")
34-
}, ignoreNULL = TRUE)
35-
35+
updateActionButton(
36+
session, 'send',
37+
label = 'Successfully Sent!'
38+
)
39+
},
40+
ignoreNULL = TRUE
41+
)
42+
# File input ====
3643
dataInput <- reactive({
3744
if (is.null(input$datafile))
3845
return(NULL)
39-
withProgress(message = "Processing uploaded data...", value = 0.4, {
46+
withProgress(message = 'Processing uploaded data...', value = 0.4, {
4047
if (input$datafile$type == 'application/x-zip-compressed') {
4148
fileunz = unzip(input$datafile$datapath)
4249
untidydata <- read.table(
@@ -46,18 +53,21 @@ shinyServer(function(input, output, session) {
4653
dec = input$dec
4754
)
4855
}
49-
else if (input$datafile$type == 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet') {
56+
else if (
57+
input$datafile$type ==
58+
'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet') {
5059
fileunz <- input$datafile$datapath
5160
untidydata <- data.table(
5261
read.xlsx2(
5362
fileunz,
54-
sheetName = "Data"
63+
sheetName = 'Data'
5564
)
5665
)
5766
incProgress(0.4)
5867
as.numeric.factor <- function(x) {as.numeric(levels(x))[x]}
5968
datacolnames <- colnames(untidydata)
60-
untidydata[, (datacolnames) := lapply(.SD, as.numeric.factor), .SDcols = datacolnames]
69+
untidydata[, (datacolnames) := lapply(.SD, as.numeric.factor),
70+
.SDcols = datacolnames]
6171
}
6272
else {
6373
fileunz <- input$datafile$datapath
@@ -72,7 +82,7 @@ shinyServer(function(input, output, session) {
7282
mLab$insert(
7383
data.frame(
7484
Sys.Date(),
75-
"File",
85+
'File',
7686
input$datafile$name,
7787
input$datafile$type,
7888
input$datafile$size,
@@ -83,76 +93,55 @@ shinyServer(function(input, output, session) {
8393
file.remove(fileunz)
8494
return(untidydata)
8595
})
96+
# Data processing ====
8697
dataProcessed <- reactive({
8798
factor <- 3600 / (input$interval * 60)
8899
untidydata <- dataInput()
100+
if (is.null(untidydata)) return(NULL)
89101
untidydata$time <- round(untidydata$time * factor) / factor
90-
untidydata %>% fill(2:length(.)) %>% group_by(time) %>% summarize_each(funs(mean)) %>% arrange(time)
102+
as.data.frame.list(untidydata) %>% fill(2:length(.)) %>% group_by(time) %>%
103+
summarize_all(funs(mean)) %>% arrange(time)
91104
})
92105

93-
output$filename <- renderText({
94-
if (!is.null(input$datafile$name))
95-
paste("Uploaded file name is ", input$datafile$name)
96-
})
97-
output$filesize <- renderText({
98-
if (!is.null(input$datafile$size))
99-
paste("Uploaded file size is ",
100-
round(input$datafile$size / 1024),
101-
" kB")
102-
})
103-
output$inputdim <- renderText({
104-
if (!is.null(input$datafile$size))
105-
paste(
106-
"Uploaded table dimensions are ",
107-
dim(dataInput())[1],
108-
" x ",
109-
dim(dataInput())[2],
110-
" (rows x cols)"
111-
)
112-
})
113-
output$processeddim <- renderText({
114-
if (!is.null(input$datafile$size))
115-
paste(
116-
"Processed table dimensions are ",
117-
dim(dataProcessed())[1],
118-
" x ",
119-
dim(dataProcessed())[2],
120-
" (rows x cols)"
121-
)
122-
})
106+
# Processed file download ====
123107
output$downloadData <- downloadHandler(
124108
# This function returns a string which tells the client
125109
# browser what name to use when saving the file.
126110
filename = function() {
127-
if (input$datafile$type == 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet')
111+
if (input$datafile$type ==
112+
'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet')
128113
paste(input$datafile$name)
129114
else {
130115
filetype <-
131116
switch(input$sep,
132117
";" = "csv",
133118
"," = "csv",
134119
"\t" = "tsv")
135-
paste("TidyData", filetype, sep = ".")
120+
paste('TidyData', filetype, sep = '.')
136121
}
137122
}
138123
,
139124
# This function should write data to a file given to it by
140125
# the argument 'file'.
141126
content = function(file) {
142127
# Write to a file specified by the 'file' argument
143-
if (input$datafile$type == 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet') {
144-
withProgress(message = "Writing processed data...", value = 0.4, {
145-
write.xlsx2(
146-
data.frame(dataProcessed()),
147-
input$datafile$datapath,
148-
sheetName = "TidyData",
149-
row.names = FALSE,
150-
append = TRUE,
151-
showNA = TRUE
152-
)
153-
incProgress(0.4)
154-
file.copy(input$datafile$datapath, file)
155-
})
128+
if (input$datafile$type ==
129+
'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet') {
130+
withProgress(
131+
message = 'Writing processed data...',
132+
value = 0.4,
133+
{
134+
write.xlsx2(
135+
data.frame(dataProcessed()),
136+
input$datafile$datapath,
137+
sheetName = 'TidyData',
138+
row.names = FALSE,
139+
append = TRUE,
140+
showNA = TRUE
141+
)
142+
incProgress(0.4)
143+
file.copy(input$datafile$datapath, file)
144+
})
156145
}
157146
else {
158147
write.table(
@@ -165,4 +154,90 @@ shinyServer(function(input, output, session) {
165154
}
166155
}
167156
)
168-
})
157+
# Growth Rates calculataion ====
158+
growthRates <- reactive({
159+
withProgress(
160+
message = 'Calculating growth rates...',
161+
value = 0.0,
162+
{
163+
data <- data.frame(dataProcessed())
164+
pumpon <- which(data[, 'pumps.pump.5'] > 0)
165+
expfitstart <- c()
166+
expfitstop <- c()
167+
time <- c()
168+
TD <- c()
169+
R2 <- c()
170+
for (i in 2:(length(pumpon) - 1)) {
171+
if (data[pumpon[i] - 1, 'pumps.pump.5'] == 0) expfitstop <- c(expfitstop, pumpon[i])
172+
else if (data[pumpon[i] + 1, 'pumps.pump.5'] == 0) expfitstart <- c(expfitstart, pumpon[i] + 1)
173+
}
174+
incProgress(0.15)
175+
for (j in 1:length(expfitstart)) {
176+
# interval <- c((expfitstop[j] - ceiling(expfitstop[j] - expfitstart[j]) * (1 - input$lag)):expfitstop[j])
177+
interval <- c((expfitstart[j] + ceiling(input$lag/input$interval)):expfitstop[j])
178+
timefit <- data[interval, 'time']
179+
datafit <- data[interval, 'od.sensors.od.680']
180+
fit <- nls(datafit ~ exp(a + b * timefit),
181+
start = list(a = 0, b = 0.5),
182+
control = list(maxiter = 99, warnOnly = TRUE))
183+
time <- c(time, timefit[length(timefit)])
184+
R2 <- c(R2, cor(datafit,predict(fit)))
185+
TD <- c(TD, 1/coef(fit)[2]*log(2))
186+
incProgress(0.15 + (j/length(expfitstart))*0.85)
187+
}
188+
})
189+
return(data.frame(time, TD, R2))
190+
})
191+
# UI outputs hadling ====
192+
output$filename <- renderText({
193+
if (!is.null(input$datafile$name))
194+
paste('Uploaded file name is ', input$datafile$name)
195+
})
196+
output$filesize <- renderText({
197+
if (!is.null(input$datafile$size))
198+
paste('Uploaded file size is ',
199+
round(input$datafile$size / 1024),
200+
' kB')
201+
})
202+
output$inputdim <- renderText({
203+
if (!is.null(input$datafile$size))
204+
paste(
205+
'Uploaded/processed table dimensions are ',
206+
dim(dataInput())[1],
207+
'/',
208+
dim(dataProcessed())[1],
209+
' x ',
210+
dim(dataInput())[2],
211+
'/',
212+
dim(dataProcessed())[2],
213+
' (rows x cols)'
214+
)
215+
})
216+
output$dataViewPlot <- renderPlot({
217+
if (!is.null(dataProcessed()))
218+
plot(x = dataProcessed()$time, y = dataProcessed()$od.sensors.od.680, xlab = 'Experiment duration, h', ylab = 'Optical density, AU')
219+
})
220+
# https://rstudio.github.io/DT/options.html
221+
# https://datatables.net/reference/option/dom
222+
output$dataProcessingTable <- DT::renderDataTable({
223+
if (!is.null(dataProcessed()))
224+
datatable(growthRates(), options = list(dom = 'tlp', pageLength = 8, lengthChange = FALSE, seraching = FALSE)) %>% formatRound(
225+
c('time','TD','R2'),
226+
digits = 2
227+
)},
228+
server = FALSE
229+
)
230+
output$dataProcessingPlot <- renderPlot({
231+
if (!is.null(dataProcessed())) {
232+
s1 = NULL
233+
s2 = input$dataProcessingTable_rows_selected
234+
plot(x = growthRates()$time, y = growthRates()$TD, xlab = 'Experiment duration, h', ylab = 'Doubling time, h')
235+
if (length(s1)) {
236+
points(growthRates()[s1, , drop = FALSE], pch = 19, cex = 1, col = 'green')
237+
}
238+
if (length(s2)) {
239+
points(growthRates()[s2, , drop = FALSE], pch = 19, cex = 1.25)
240+
}
241+
}
242+
})
243+
})

0 commit comments

Comments
 (0)