|
| 1 | +# This is the server logic for a Shiny web application. |
| 2 | +# You can find out more about building applications with Shiny here: |
| 3 | +# |
| 4 | +# http://shiny.rstudio.com |
| 5 | +# |
| 6 | + |
| 7 | +options(shiny.maxRequestSize = 12 * 1024 ^ 2) |
| 8 | + |
| 9 | +library(dplyr) |
| 10 | +library(dtplyr) |
| 11 | +library(DT) |
| 12 | +library(openxlsx) |
| 13 | +library(shiny) |
| 14 | +library(shinyBS) |
| 15 | +library(RMySQL) |
| 16 | +library(tidyr) |
| 17 | + |
| 18 | +source('DB-connect.R', echo = FALSE) |
| 19 | + |
| 20 | +dataColumnNames <- readRDS('data/dataColumnNames.rds') |
| 21 | + |
| 22 | +server <- function(input, output, session) { |
| 23 | + observeEvent(input$send, { |
| 24 | + updateActionButton( |
| 25 | + session, 'regSend', |
| 26 | + label = "Successfully Sent!" |
| 27 | + ) |
| 28 | + }, |
| 29 | + ignoreNULL = TRUE |
| 30 | + ) |
| 31 | +# File input ==== |
| 32 | + dataInput <- reactive({ |
| 33 | + if (is.null(input$dataFile) || (input$dataFile$type != 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet')) { |
| 34 | + return(NULL) |
| 35 | + } |
| 36 | + withProgress(message = "Processing uploaded data...", value = 0.4, { |
| 37 | + untidyData <- readWorkbook(input$dataFile$datapath, sheet = 'Data') |
| 38 | + incProgress(0.4) |
| 39 | + }) |
| 40 | + return(untidyData) |
| 41 | + }) |
| 42 | +# Data processing ==== |
| 43 | + dataProcessed <- reactive({ |
| 44 | + untidyData <- dataInput() |
| 45 | + if (is.null(untidyData)) { |
| 46 | + return(NULL) |
| 47 | + } |
| 48 | + selectChoices <- merge(data.frame(X = colnames(untidyData)), dataColumnNames) |
| 49 | + updateSelectInput(session, 'dataColumn', choices = selectChoices$Y, selected = 'OD680, AU') |
| 50 | + factor <- 3600 / (input$interval * 60) |
| 51 | + untidyData$time <- round(untidyData$time * factor) / factor |
| 52 | + untidyData %>% |
| 53 | + fill(2:length(.)) %>% |
| 54 | + group_by(time) %>% |
| 55 | + summarize_all(mean) %>% |
| 56 | + arrange(time) |
| 57 | + }) |
| 58 | +# Processed file download ==== |
| 59 | + output$downloadData <- downloadHandler( |
| 60 | + # This function returns a string which tells the client |
| 61 | + # browser what name to use when saving the file. |
| 62 | + filename = function() { |
| 63 | + if (input$dataFile$type == |
| 64 | + 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet') { |
| 65 | + paste(input$dataFile$name) |
| 66 | + } |
| 67 | + } |
| 68 | + , |
| 69 | + # This function should write data to a file given to it by |
| 70 | + # the argument 'file'. |
| 71 | + content = function(file) { |
| 72 | + # Write to a file specified by the 'file' argument |
| 73 | + if (input$dataFile$type == |
| 74 | + 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet') { |
| 75 | + withProgress( |
| 76 | + message = "Writing processed data...", |
| 77 | + value = 0.4, |
| 78 | + { |
| 79 | + pbrDataFile <- loadWorkbook(file = input$dataFile$datapath) |
| 80 | + addWorksheet(pbrDataFile, 'TidyData') |
| 81 | + writeData(pbrDataFile, 'TidyData', dataProcessed()) |
| 82 | + saveWorkbook(pbrDataFile, input$dataFile$datapath, overwrite = TRUE) |
| 83 | + incProgress(0.4) |
| 84 | + file.copy(input$dataFile$datapath, file) |
| 85 | + } |
| 86 | + ) |
| 87 | + } |
| 88 | + } |
| 89 | + ) |
| 90 | +# Growth Rates calculataion ==== |
| 91 | + growthRates <- reactive({ |
| 92 | + withProgress( |
| 93 | + message = "Calculating growth rates...", |
| 94 | + value = 0.0, |
| 95 | + { |
| 96 | + data <- dataProcessed() |
| 97 | + pumpOn <- which(data$`pumps.pump-5` > 0) |
| 98 | + expFitStart <- c() |
| 99 | + expFitStop <- c() |
| 100 | + time <- c() |
| 101 | + Dt <- c() |
| 102 | + R2 <- c() |
| 103 | + for (i in 2:(length(pumpOn) - 1)) { |
| 104 | + if (data$`pumps.pump-5`[pumpOn[i] - 1] == 0) expFitStop <- c(expFitStop, pumpOn[i]) |
| 105 | + else if (data$`pumps.pump-5`[pumpOn[i] + 1] == 0) expFitStart <- c(expFitStart, pumpOn[i] + 1) |
| 106 | + } |
| 107 | + incProgress(0.15) |
| 108 | + for (j in 1:length(expFitStart)) { |
| 109 | + # interval <- c((expFitStop[j] - ceiling(expFitStop[j] - expFitStart[j]) * (1 - input$lagTime)):expFitStop[j]) |
| 110 | + interval <- c((expFitStart[j] + ceiling(input$lagTime/input$interval)):expFitStop[j]) |
| 111 | + timeFit <- data$time[interval] |
| 112 | + dataFit <- data$`od-sensors.od-680`[interval] |
| 113 | + fit <- nls(dataFit ~ exp(a + b * timeFit), |
| 114 | + start = list(a = 0, b = 0.5), |
| 115 | + control = list(maxiter = 99, warnOnly = TRUE)) |
| 116 | + time <- c(time, timeFit[length(timeFit)]) |
| 117 | + R2 <- c(R2, cor(dataFit, predict(fit))) |
| 118 | + Dt <- c(Dt, 1 / coef(fit)[2] * log(2)) |
| 119 | + incProgress(0.15 + (j / length(expFitStart)) * 0.85) |
| 120 | + } |
| 121 | + }) |
| 122 | + return(data.frame(time, Dt, R2)) |
| 123 | + }) |
| 124 | +# UI outputs hadling ==== |
| 125 | + output$fileName <- renderText({ |
| 126 | + if (!is.null(input$dataFile$name)) |
| 127 | + paste("Uploaded file name is ", input$dataFile$name) |
| 128 | + }) |
| 129 | + output$fileSize <- renderText({ |
| 130 | + if (!is.null(input$dataFile$size)) |
| 131 | + paste("Uploaded file size is ", |
| 132 | + round(input$dataFile$size / 1024), |
| 133 | + " kB") |
| 134 | + }) |
| 135 | + output$dataDim <- renderText({ |
| 136 | + if (!is.null(input$dataFile$size)) |
| 137 | + paste( |
| 138 | + "Uploaded/processed table dimensions are ", |
| 139 | + dim(dataInput())[1], |
| 140 | + "/", |
| 141 | + dim(dataProcessed())[1], |
| 142 | + " x ", |
| 143 | + dim(dataInput())[2], |
| 144 | + " (rows x cols)" |
| 145 | + ) |
| 146 | + }) |
| 147 | + output$dataViewPlot <- renderPlot({ |
| 148 | + data <- dataProcessed() |
| 149 | + if (!is.null(data)) { |
| 150 | + plot(x = data$time, y = data[[dataColumnNames$X[match(input$dataColumn, dataColumnNames$Y)]]], xlab = 'Experiment duration, h', ylab = 'Optical density, AU') |
| 151 | + } |
| 152 | + }) |
| 153 | + |
| 154 | + # https://rstudio.github.io/DT/options.html |
| 155 | + # https://datatables.net/reference/option/dom |
| 156 | + output$dataProcessingTable <- DT::renderDataTable({ |
| 157 | + if (!is.null(dataProcessed())) |
| 158 | + datatable(growthRates(), |
| 159 | + options = list(dom = 'tlp', pageLength = 8, lengthChange = FALSE, searching = FALSE)) %>% |
| 160 | + formatRound(c('time','Dt','R2'), digits = 2) |
| 161 | + }, |
| 162 | + server = FALSE |
| 163 | + ) |
| 164 | + output$dataProcessingPlot <- renderPlot({ |
| 165 | + if (!is.null(dataProcessed())) { |
| 166 | + s1 = NULL |
| 167 | + s2 = input$dataProcessingTable_rows_selected |
| 168 | + gRates <- growthRates() |
| 169 | + plot(x = gRates$time, y = gRates$Dt, xlab = "Experiment duration, h", ylab = "Doubling time, h") |
| 170 | + if (length(s1)) { |
| 171 | + points(gRates[s1, , drop = FALSE], pch = 19, cex = 1, col = 'green') |
| 172 | + } |
| 173 | + if (length(s2)) { |
| 174 | + points(gRates[s2, , drop = FALSE], pch = 19, cex = 1.25) |
| 175 | + } |
| 176 | + } |
| 177 | + }) |
| 178 | +} |
| 179 | + |
| 180 | +# This is the user-interface definition of a Shiny web application. |
| 181 | +# You can find out more about building applications with Shiny here: |
| 182 | +# |
| 183 | +# http://shiny.rstudio.com |
| 184 | +# |
| 185 | + |
| 186 | +ui <- fluidPage( |
| 187 | + tags$head(includeScript('google-analytics.js')), |
| 188 | + titlePanel("", windowTitle = "Tidy Up Data"), |
| 189 | + sidebarLayout( |
| 190 | + # Sidebar panel ==== |
| 191 | + sidebarPanel( |
| 192 | + conditionalPanel( |
| 193 | + condition = 'input.conditionedSidePanels == 1', |
| 194 | + fluidRow( |
| 195 | + fileInput( |
| 196 | + 'dataFile', |
| 197 | + "Choose data file to upload", |
| 198 | + accept = c( |
| 199 | + 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet', |
| 200 | + '.xlsx' |
| 201 | + ) |
| 202 | + ) |
| 203 | + ), |
| 204 | + fluidRow( |
| 205 | + sliderInput( |
| 206 | + 'interval', |
| 207 | + "Averaging interval, min", |
| 208 | + value = 1, min = 0.5, max = 10, step = 0.1 |
| 209 | + ), |
| 210 | + # numericInput('interval', 'Interval, min', 1, min = 0.5, max = 10, step = 0.1, width = '100px'), |
| 211 | + bsTooltip( |
| 212 | + 'interval', |
| 213 | + "Interval that is used for lumping and averaging untidy data. Provided in minutes.", |
| 214 | + 'right', options = list(container = 'body') |
| 215 | + ) |
| 216 | + ), |
| 217 | + fluidRow( |
| 218 | + downloadButton('downloadData', "Download") |
| 219 | + ), |
| 220 | + tags$hr(), |
| 221 | + fluidRow( |
| 222 | + selectInput('dataColumn', "Data to View", "OD680, AU") |
| 223 | + ), |
| 224 | + tags$hr() |
| 225 | + ), |
| 226 | + conditionalPanel( |
| 227 | + condition = 'input.conditionedSidePanels == 2', |
| 228 | + fluidRow( |
| 229 | + sliderInput( |
| 230 | + 'lagTime', |
| 231 | + "Lag time, min", |
| 232 | + value = 5, min = 0, max = 30, step = 1 |
| 233 | + ), |
| 234 | + bsTooltip( |
| 235 | + 'lagTime', |
| 236 | + "Length of lag time that defines part of data that are influenced by the dilution. Provided in minutes.", |
| 237 | + 'right', |
| 238 | + options = list(container = 'body') |
| 239 | + ) |
| 240 | + ) |
| 241 | + ), |
| 242 | + width = 3 |
| 243 | + ), |
| 244 | + # Main panel ==== |
| 245 | + mainPanel( |
| 246 | + tabsetPanel( |
| 247 | + type = 'tabs', |
| 248 | + tabPanel( |
| 249 | + "Data Processing", |
| 250 | + value = 1, |
| 251 | + strong(textOutput('count')), |
| 252 | + br(), |
| 253 | + strong(textOutput('fileName')), |
| 254 | + em(textOutput('fileSize')), |
| 255 | + br(), |
| 256 | + textOutput('dataDim'), |
| 257 | + plotOutput('dataViewPlot', width = '90%') |
| 258 | + ), |
| 259 | + tabPanel( |
| 260 | + "Data Analysis", |
| 261 | + value = 2, |
| 262 | + fluidRow( |
| 263 | + column( |
| 264 | + 4, |
| 265 | + br(), |
| 266 | + DT::dataTableOutput('dataProcessingTable') |
| 267 | + ), |
| 268 | + column( |
| 269 | + 8, |
| 270 | + plotOutput('dataProcessingPlot') |
| 271 | + ) |
| 272 | + ) |
| 273 | + ), |
| 274 | + id = 'conditionedSidePanels' |
| 275 | + ), |
| 276 | + width = 9 |
| 277 | + ) |
| 278 | + ), |
| 279 | + # Bottom panel ==== |
| 280 | + fluidRow( |
| 281 | + column( |
| 282 | + width = 3, |
| 283 | + actionLink('register', label = "Register to support further development"), |
| 284 | + tags$p(), |
| 285 | + conditionalPanel( |
| 286 | + 'input.register', |
| 287 | + textInput('regName', label = "First name", value = "First name"), |
| 288 | + textInput('regSurname', label = "Last name", value = "Last name"), |
| 289 | + textInput('regEmail', label = "Email", value = "@"), |
| 290 | + textInput('regOrganization', label = "Organization", value = "Organization"), |
| 291 | + textInput('regDepartment', label = "Department", value = "Department"), |
| 292 | + actionButton('regSend', label = "Send"), |
| 293 | + tags$hr(), |
| 294 | + p( |
| 295 | + "@author CzechGlobe - Department of Adaptive Biotechnologies (JaCe)" |
| 296 | + ), |
| 297 | + p( |
| 298 | + "@email cerveny.j@czechglobe.cz" |
| 299 | + ) |
| 300 | + ) |
| 301 | + ), |
| 302 | + column( |
| 303 | + width = 7, |
| 304 | + actionLink('help', label = "Help"), |
| 305 | + conditionalPanel( |
| 306 | + 'input.help', |
| 307 | + p( |
| 308 | + "This tool was developed to simplify manipulation with untidy data generated by Photon Systems Instruments (PSI) photobioreactor sofware. The data uploaded to this tool are expected in Excel (.xlsx) format." |
| 309 | + ), |
| 310 | + p( |
| 311 | + "For PSI photobioreactor software exported data, the most simple untidy data preparation procedure is to export data from the software in .ods format and then save (as) the file in .xlsx Excel format." |
| 312 | + ) |
| 313 | + ), |
| 314 | + offset = 1 |
| 315 | + ) |
| 316 | + ), |
| 317 | + fluidRow( |
| 318 | + column( |
| 319 | + 2, |
| 320 | + tags$img(src = 'img/Logo-CzechGlobe.jpg', alt = "CzechGlobe", height = 60, align = 'top') |
| 321 | + ), |
| 322 | + column( |
| 323 | + 1, |
| 324 | + tags$img(src = 'img/Logo-C4Sys.jpg', alt = "C4Sys", height = 45, align = 'right') |
| 325 | + ) |
| 326 | + ) |
| 327 | +) |
| 328 | + |
| 329 | +shinyApp(ui = ui, server = server) |
0 commit comments