From 95189e1b815ce924367b1f50075e147d99973c66 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20=C4=8Cerven=C3=BD?= Date: Sun, 6 Aug 2017 19:02:54 -0400 Subject: [PATCH 1/5] 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. --- server.R | 193 ++++++++++++++++++++++++++++++-------------- ui.R | 241 ++++++++++++++++++++++++++++++++++++------------------- 2 files changed, 293 insertions(+), 141 deletions(-) diff --git a/server.R b/server.R index c9773a6..3cebea1 100644 --- a/server.R +++ b/server.R @@ -7,11 +7,14 @@ options( shiny.maxRequestSize = 12 * 1024 ^ 2 ) options( java.parameters = "-Xmx4g" ) -library(shiny) +library(data.table) +library(DT) library(dplyr) library(dtplyr) -library(tidyr) library(mongolite) +library(shiny) +library(shinyBS) +library(tidyr) library(xlsx) source("mlabDB-connect.R", echo = FALSE) @@ -21,7 +24,7 @@ shinyServer(function(input, output, session) { mLab$insert( data.frame( Sys.Date(), - "User", + 'User', input$name, input$surname, input$email, @@ -29,14 +32,18 @@ shinyServer(function(input, output, session) { input$department ) ) - updateActionButton(session, "send", - label = "Successfully Sent!") - }, ignoreNULL = TRUE) - + updateActionButton( + session, 'send', + label = 'Successfully Sent!' + ) + }, + ignoreNULL = TRUE + ) +# File input ==== dataInput <- reactive({ if (is.null(input$datafile)) return(NULL) - withProgress(message = "Processing uploaded data...", value = 0.4, { + withProgress(message = 'Processing uploaded data...', value = 0.4, { if (input$datafile$type == 'application/x-zip-compressed') { fileunz = unzip(input$datafile$datapath) untidydata <- read.table( @@ -46,18 +53,21 @@ shinyServer(function(input, output, session) { dec = input$dec ) } - else if (input$datafile$type == 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet') { + else if ( + input$datafile$type == + 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet') { fileunz <- input$datafile$datapath untidydata <- data.table( read.xlsx2( fileunz, - sheetName = "Data" + sheetName = 'Data' ) ) incProgress(0.4) as.numeric.factor <- function(x) {as.numeric(levels(x))[x]} datacolnames <- colnames(untidydata) - untidydata[, (datacolnames) := lapply(.SD, as.numeric.factor), .SDcols = datacolnames] + untidydata[, (datacolnames) := lapply(.SD, as.numeric.factor), + .SDcols = datacolnames] } else { fileunz <- input$datafile$datapath @@ -72,7 +82,7 @@ shinyServer(function(input, output, session) { mLab$insert( data.frame( Sys.Date(), - "File", + 'File', input$datafile$name, input$datafile$type, input$datafile$size, @@ -83,48 +93,23 @@ shinyServer(function(input, output, session) { file.remove(fileunz) return(untidydata) }) +# Data processing ==== dataProcessed <- reactive({ factor <- 3600 / (input$interval * 60) untidydata <- dataInput() + if (is.null(untidydata)) return(NULL) untidydata$time <- round(untidydata$time * factor) / factor - untidydata %>% fill(2:length(.)) %>% group_by(time) %>% summarize_each(funs(mean)) %>% arrange(time) + as.data.frame.list(untidydata) %>% fill(2:length(.)) %>% group_by(time) %>% + summarize_all(funs(mean)) %>% arrange(time) }) - output$filename <- renderText({ - if (!is.null(input$datafile$name)) - paste("Uploaded file name is ", input$datafile$name) - }) - output$filesize <- renderText({ - if (!is.null(input$datafile$size)) - paste("Uploaded file size is ", - round(input$datafile$size / 1024), - " kB") - }) - output$inputdim <- renderText({ - if (!is.null(input$datafile$size)) - paste( - "Uploaded table dimensions are ", - dim(dataInput())[1], - " x ", - dim(dataInput())[2], - " (rows x cols)" - ) - }) - output$processeddim <- renderText({ - if (!is.null(input$datafile$size)) - paste( - "Processed table dimensions are ", - dim(dataProcessed())[1], - " x ", - dim(dataProcessed())[2], - " (rows x cols)" - ) - }) +# Processed file download ==== output$downloadData <- downloadHandler( # This function returns a string which tells the client # browser what name to use when saving the file. filename = function() { - if (input$datafile$type == 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet') + if (input$datafile$type == + 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet') paste(input$datafile$name) else { filetype <- @@ -132,7 +117,7 @@ shinyServer(function(input, output, session) { ";" = "csv", "," = "csv", "\t" = "tsv") - paste("TidyData", filetype, sep = ".") + paste('TidyData', filetype, sep = '.') } } , @@ -140,19 +125,23 @@ shinyServer(function(input, output, session) { # the argument 'file'. content = function(file) { # Write to a file specified by the 'file' argument - if (input$datafile$type == 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet') { - withProgress(message = "Writing processed data...", value = 0.4, { - write.xlsx2( - data.frame(dataProcessed()), - input$datafile$datapath, - sheetName = "TidyData", - row.names = FALSE, - append = TRUE, - showNA = TRUE - ) - incProgress(0.4) - file.copy(input$datafile$datapath, file) - }) + if (input$datafile$type == + 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet') { + withProgress( + message = 'Writing processed data...', + value = 0.4, + { + write.xlsx2( + data.frame(dataProcessed()), + input$datafile$datapath, + sheetName = 'TidyData', + row.names = FALSE, + append = TRUE, + showNA = TRUE + ) + incProgress(0.4) + file.copy(input$datafile$datapath, file) + }) } else { write.table( @@ -165,4 +154,90 @@ shinyServer(function(input, output, session) { } } ) -}) \ No newline at end of file +# Growth Rates calculataion ==== + growthRates <- reactive({ + withProgress( + message = 'Calculating growth rates...', + value = 0.0, + { + data <- data.frame(dataProcessed()) + pumpon <- which(data[, 'pumps.pump.5'] > 0) + expfitstart <- c() + expfitstop <- c() + time <- c() + TD <- c() + R2 <- c() + for (i in 2:(length(pumpon) - 1)) { + if (data[pumpon[i] - 1, 'pumps.pump.5'] == 0) expfitstop <- c(expfitstop, pumpon[i]) + else if (data[pumpon[i] + 1, 'pumps.pump.5'] == 0) expfitstart <- c(expfitstart, pumpon[i] + 1) + } + incProgress(0.15) + for (j in 1:length(expfitstart)) { + # interval <- c((expfitstop[j] - ceiling(expfitstop[j] - expfitstart[j]) * (1 - input$lag)):expfitstop[j]) + interval <- c((expfitstart[j] + ceiling(input$lag/input$interval)):expfitstop[j]) + timefit <- data[interval, 'time'] + datafit <- data[interval, 'od.sensors.od.680'] + fit <- nls(datafit ~ exp(a + b * timefit), + start = list(a = 0, b = 0.5), + control = list(maxiter = 99, warnOnly = TRUE)) + time <- c(time, timefit[length(timefit)]) + R2 <- c(R2, cor(datafit,predict(fit))) + TD <- c(TD, 1/coef(fit)[2]*log(2)) + incProgress(0.15 + (j/length(expfitstart))*0.85) + } + }) + return(data.frame(time, TD, R2)) + }) +# UI outputs hadling ==== + output$filename <- renderText({ + if (!is.null(input$datafile$name)) + paste('Uploaded file name is ', input$datafile$name) + }) + output$filesize <- renderText({ + if (!is.null(input$datafile$size)) + paste('Uploaded file size is ', + round(input$datafile$size / 1024), + ' kB') + }) + output$inputdim <- renderText({ + if (!is.null(input$datafile$size)) + paste( + 'Uploaded/processed table dimensions are ', + dim(dataInput())[1], + '/', + dim(dataProcessed())[1], + ' x ', + dim(dataInput())[2], + '/', + dim(dataProcessed())[2], + ' (rows x cols)' + ) + }) + output$dataViewPlot <- renderPlot({ + if (!is.null(dataProcessed())) + plot(x = dataProcessed()$time, y = dataProcessed()$od.sensors.od.680, xlab = 'Experiment duration, h', ylab = 'Optical density, AU') + }) + # https://rstudio.github.io/DT/options.html + # https://datatables.net/reference/option/dom + output$dataProcessingTable <- DT::renderDataTable({ + if (!is.null(dataProcessed())) + datatable(growthRates(), options = list(dom = 'tlp', pageLength = 8, lengthChange = FALSE, seraching = FALSE)) %>% formatRound( + c('time','TD','R2'), + digits = 2 + )}, + server = FALSE + ) + output$dataProcessingPlot <- renderPlot({ + if (!is.null(dataProcessed())) { + s1 = NULL + s2 = input$dataProcessingTable_rows_selected + plot(x = growthRates()$time, y = growthRates()$TD, xlab = 'Experiment duration, h', ylab = 'Doubling time, h') + if (length(s1)) { + points(growthRates()[s1, , drop = FALSE], pch = 19, cex = 1, col = 'green') + } + if (length(s2)) { + points(growthRates()[s2, , drop = FALSE], pch = 19, cex = 1.25) + } + } + }) +}) diff --git a/ui.R b/ui.R index aa340ac..4784fef 100644 --- a/ui.R +++ b/ui.R @@ -4,106 +4,172 @@ # http://shiny.rstudio.com # +library(data.table) +library(DT) +library(dplyr) +library(dtplyr) +library(mongolite) library(shiny) +library(shinyBS) +library(tidyr) +library(xlsx) shinyUI(fluidPage( - tags$head(includeScript("google-analytics.js")), - titlePanel("Tidy Up PBR Data", windowTitle = "Tidy Up Data"), + tags$head(includeScript('google-analytics.js')), + titlePanel('', windowTitle = 'Tidy Up Data'), sidebarLayout( + # Sidebar panel ==== sidebarPanel( - fluidRow( - column(7, fileInput( - 'datafile', - 'Choose data file to upload', - accept = c( - 'application/x-zip-compressed', - 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet', - 'text/csv', - 'text/comma-separated-values', - 'text/tab-separated-values', - 'text/plain', - '.xlsx', - '.csv', - '.tsv' + conditionalPanel( + condition = 'input.conditionedSidePanels==1', + fluidRow( + fileInput( + 'datafile', + 'Choose data file to upload', + accept = c( + 'application/x-zip-compressed', + 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet', + 'text/csv', + 'text/comma-separated-values', + 'text/tab-separated-values', + 'text/plain', + '.xlsx', + '.csv', + '.tsv' + ) + ) + ), + fluidRow( + sliderInput( + 'interval', + 'Averaging interval, min', + value = 1, min = 0.5, max = 10, step = 0.1 + ), + # numericInput('interval', 'Interval, min', 1, min = 0.5, max = 10, step = 0.1, width = '100px'), + bsTooltip( + 'interval', + 'Interval that is used for lumping and averaging untidy data. Provided in minutes.', + 'right', options = list(container = 'body') ) - )), - column( - 5, - numericInput('interval', 'Averaging interval [min]', 1, 0.5, 10, 0.1, '200px'), + ), + fluidRow( downloadButton('downloadData', 'Download') + ), + tags$hr(), + fluidRow( + column( + width = 6, + 'Plain text data:' + ), + column( + width = 6, + checkboxInput('header', 'Header', TRUE) + ) + ), + fluidRow( + column( + width = 6, + radioButtons( + 'sep', + 'Separator', + c( + Comma = ',', + Semicolon = ';', + Tab = '\t' + ), + ',' + ) + ), + column( + width = 6, + radioButtons( + 'dec', + 'Decimal', + c('Point' = '.', + 'Comma' = ','), + '.' + ) + ) ) ), - tags$hr(), - tags$p( - "For plan text data formats:" - ), - fluidRow( - column(4, checkboxInput('header', 'Header', TRUE)), - column(4, radioButtons( - 'sep', 'Separator', - c( - Comma = ',', - Semicolon = ';', - Tab = '\t' + conditionalPanel( + condition = 'input.conditionedSidePanels==2', + fluidRow( + sliderInput( + 'lag', + 'Lag time, min', + value = 5, min = 0, max = 30, step = 1 ), - ',' - )), - column(4, radioButtons( - 'dec', 'Decimal mark', - c('Point' = '.', - 'Comma' = ','), - '.' - )) - ), - tags$hr(), - p( - "@author CzechGlobe - Department of Adaptive Biotechnologies (JaCe)" - ), - fluidRow(column( - 12, - actionLink("register", label = "Register to support development of additional PBR tools"), - conditionalPanel( - "input.register", - textInput("name", label = "First name", value = "First name"), - textInput("surname", label = "Last name", value = "Last name"), - textInput("email", label = "Email", value = "@"), - textInput("organization", label = "Organization", value = "Organization"), - textInput("department", label = "Department", value = "Department"), - actionButton("send", label = "Send"), - p( - "@email cerveny.j@czechglobe.cz" + bsTooltip( + 'lag', + 'Length of lag time that defines part of data that are influenced by the dilution. Provided in minutes.', + 'right', + options = list(container = 'body') ) ) - )) - , - width = 5 + ), + width = 3 ), + # Main panel ==== mainPanel( - strong(textOutput("count")), - br(), - strong(textOutput("filename")), - em(textOutput("filesize")), - br(), - textOutput("inputdim"), - textOutput("processeddim"), - width = 7 + tabsetPanel( + type = 'tabs', + tabPanel( + 'Data Processing', + value = 1, + strong(textOutput("count")), + br(), + strong(textOutput("filename")), + em(textOutput("filesize")), + br(), + textOutput('inputdim'), + plotOutput('dataViewPlot', width = '90%') + ), + tabPanel( + 'Data Analysis', + value = 2, + fluidRow( + column( + 4, + br(), + DT::dataTableOutput('dataProcessingTable') + ), + column( + 8, + plotOutput('dataProcessingPlot') + ) + ) + ), + id = 'conditionedSidePanels' + ), + width = 9 ) ), + # Bottom panel ==== fluidRow( column( - 3, - tags$img(src = "img/Logo-CzechGlobe.jpg", alt = "CzechGlobe", height = 60, align = "top") - ), - column( - 2, - tags$img(src = "img/Logo-C4Sys.jpg", alt = "C4Sys", height = 40, align = "right") - ), - column( - 1, - br() + width = 3, + actionLink('register', label = 'Register to support further development'), + tags$p(), + conditionalPanel( + 'input.register', + textInput("name", label = "First name", value = "First name"), + textInput("surname", label = "Last name", value = "Last name"), + textInput("email", label = "Email", value = "@"), + textInput("organization", label = "Organization", value = "Organization"), + textInput("department", label = "Department", value = "Department"), + actionButton("send", label = "Send"), + tags$hr(), + p( + '@author CzechGlobe - Department of Adaptive Biotechnologies (JaCe)' + ), + p( + "@email cerveny.j@czechglobe.cz" + ) + ) ), column( - 5, + width = 7, actionLink("help", label = "Help"), conditionalPanel( "input.help", @@ -116,7 +182,18 @@ shinyUI(fluidPage( p( "In general this tool can be used on any numeric data table, e.g. for large datasets tidying up, averaging, etc." ) - ) + ), + offset = 1 + ) + ), + fluidRow( + column( + 2, + tags$img(src = "img/Logo-CzechGlobe.jpg", alt = "CzechGlobe", height = 60, align = "top") + ), + column( + 1, + tags$img(src = "img/Logo-C4Sys.jpg", alt = "C4Sys", height = 45, align = "right") ) ) -)) \ No newline at end of file +)) From b6f62ad60346a6cbddad2b8b3f9992daf896580c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20=C4=8Cerven=C3=BD?= Date: Wed, 9 Aug 2017 07:52:01 -0400 Subject: [PATCH 2/5] Initial upload for openxlsx implementation -Using openxlsx library from now to reduce both RAM and CPU use. -Code simplified -Only .xlsx files now supported -Added checkbox select to chose which data to display --- DB-connect.R | 1 + README.md | 3 - app.R | 329 ++++++++++++++++++++++++++++++++++++++ data/dataColumnNames.rds | Bin 0 -> 922 bytes data/dataColumnNames.xlsx | Bin 0 -> 10395 bytes mlabDB-connect.R | 2 - server.R | 243 ---------------------------- ui.R | 199 ----------------------- 8 files changed, 330 insertions(+), 447 deletions(-) create mode 100644 DB-connect.R delete mode 100644 README.md create mode 100644 app.R create mode 100644 data/dataColumnNames.rds create mode 100644 data/dataColumnNames.xlsx delete mode 100644 mlabDB-connect.R delete mode 100644 server.R delete mode 100644 ui.R diff --git a/DB-connect.R b/DB-connect.R new file mode 100644 index 0000000..7affb73 --- /dev/null +++ b/DB-connect.R @@ -0,0 +1 @@ +# con <- dbConnect(RMySQL::MySQL(), dbname = NULL, username = 'DoAB', password = 'VT16Drasov', host = 'gcri-doab-ext.diskstation.me', port = 33633) diff --git a/README.md b/README.md deleted file mode 100644 index 51b4bf3..0000000 --- a/README.md +++ /dev/null @@ -1,3 +0,0 @@ -"# PBR-DataAnalyses" -"# PBR-DataAnalyses" -"# PBR-DataAnalyses" diff --git a/app.R b/app.R new file mode 100644 index 0000000..bf152ab --- /dev/null +++ b/app.R @@ -0,0 +1,329 @@ +# This is the server logic for a Shiny web application. +# You can find out more about building applications with Shiny here: +# +# http://shiny.rstudio.com +# + +options(shiny.maxRequestSize = 12 * 1024 ^ 2) + +library(dplyr) +library(dtplyr) +library(DT) +library(openxlsx) +library(shiny) +library(shinyBS) +library(RMySQL) +library(tidyr) + +source('DB-connect.R', echo = FALSE) + +dataColumnNames <- readRDS('data/dataColumnNames.rds') + +server <- function(input, output, session) { + observeEvent(input$send, { + updateActionButton( + session, 'regSend', + label = "Successfully Sent!" + ) + }, + ignoreNULL = TRUE + ) +# File input ==== + dataInput <- reactive({ + if (is.null(input$dataFile) || (input$dataFile$type != 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet')) { + return(NULL) + } + withProgress(message = "Processing uploaded data...", value = 0.4, { + untidyData <- readWorkbook(input$dataFile$datapath, sheet = 'Data') + incProgress(0.4) + }) + return(untidyData) + }) +# Data processing ==== + dataProcessed <- reactive({ + untidyData <- dataInput() + if (is.null(untidyData)) { + return(NULL) + } + selectChoices <- merge(data.frame(X = colnames(untidyData)), dataColumnNames) + updateSelectInput(session, 'dataColumn', choices = selectChoices$Y, selected = 'OD680, AU') + factor <- 3600 / (input$interval * 60) + untidyData$time <- round(untidyData$time * factor) / factor + untidyData %>% + fill(2:length(.)) %>% + group_by(time) %>% + summarize_all(mean) %>% + arrange(time) + }) +# Processed file download ==== + output$downloadData <- downloadHandler( + # This function returns a string which tells the client + # browser what name to use when saving the file. + filename = function() { + if (input$dataFile$type == + 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet') { + paste(input$dataFile$name) + } + } + , + # This function should write data to a file given to it by + # the argument 'file'. + content = function(file) { + # Write to a file specified by the 'file' argument + if (input$dataFile$type == + 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet') { + withProgress( + message = "Writing processed data...", + value = 0.4, + { + pbrDataFile <- loadWorkbook(file = input$dataFile$datapath) + addWorksheet(pbrDataFile, 'TidyData') + writeData(pbrDataFile, 'TidyData', dataProcessed()) + saveWorkbook(pbrDataFile, input$dataFile$datapath, overwrite = TRUE) + incProgress(0.4) + file.copy(input$dataFile$datapath, file) + } + ) + } + } + ) +# Growth Rates calculataion ==== + growthRates <- reactive({ + withProgress( + message = "Calculating growth rates...", + value = 0.0, + { + data <- dataProcessed() + pumpOn <- which(data$`pumps.pump-5` > 0) + expFitStart <- c() + expFitStop <- c() + time <- c() + Dt <- c() + R2 <- c() + for (i in 2:(length(pumpOn) - 1)) { + if (data$`pumps.pump-5`[pumpOn[i] - 1] == 0) expFitStop <- c(expFitStop, pumpOn[i]) + else if (data$`pumps.pump-5`[pumpOn[i] + 1] == 0) expFitStart <- c(expFitStart, pumpOn[i] + 1) + } + incProgress(0.15) + for (j in 1:length(expFitStart)) { + # interval <- c((expFitStop[j] - ceiling(expFitStop[j] - expFitStart[j]) * (1 - input$lagTime)):expFitStop[j]) + interval <- c((expFitStart[j] + ceiling(input$lagTime/input$interval)):expFitStop[j]) + timeFit <- data$time[interval] + dataFit <- data$`od-sensors.od-680`[interval] + fit <- nls(dataFit ~ exp(a + b * timeFit), + start = list(a = 0, b = 0.5), + control = list(maxiter = 99, warnOnly = TRUE)) + time <- c(time, timeFit[length(timeFit)]) + R2 <- c(R2, cor(dataFit, predict(fit))) + Dt <- c(Dt, 1 / coef(fit)[2] * log(2)) + incProgress(0.15 + (j / length(expFitStart)) * 0.85) + } + }) + return(data.frame(time, Dt, R2)) + }) +# UI outputs hadling ==== + output$fileName <- renderText({ + if (!is.null(input$dataFile$name)) + paste("Uploaded file name is ", input$dataFile$name) + }) + output$fileSize <- renderText({ + if (!is.null(input$dataFile$size)) + paste("Uploaded file size is ", + round(input$dataFile$size / 1024), + " kB") + }) + output$dataDim <- renderText({ + if (!is.null(input$dataFile$size)) + paste( + "Uploaded/processed table dimensions are ", + dim(dataInput())[1], + "/", + dim(dataProcessed())[1], + " x ", + dim(dataInput())[2], + " (rows x cols)" + ) + }) + output$dataViewPlot <- renderPlot({ + data <- dataProcessed() + if (!is.null(data)) { + plot(x = data$time, y = data[[dataColumnNames$X[match(input$dataColumn, dataColumnNames$Y)]]], xlab = 'Experiment duration, h', ylab = 'Optical density, AU') + } + }) + + # https://rstudio.github.io/DT/options.html + # https://datatables.net/reference/option/dom + output$dataProcessingTable <- DT::renderDataTable({ + if (!is.null(dataProcessed())) + datatable(growthRates(), + options = list(dom = 'tlp', pageLength = 8, lengthChange = FALSE, searching = FALSE)) %>% + formatRound(c('time','Dt','R2'), digits = 2) + }, + server = FALSE + ) + output$dataProcessingPlot <- renderPlot({ + if (!is.null(dataProcessed())) { + s1 = NULL + s2 = input$dataProcessingTable_rows_selected + gRates <- growthRates() + plot(x = gRates$time, y = gRates$Dt, xlab = "Experiment duration, h", ylab = "Doubling time, h") + if (length(s1)) { + points(gRates[s1, , drop = FALSE], pch = 19, cex = 1, col = 'green') + } + if (length(s2)) { + points(gRates[s2, , drop = FALSE], pch = 19, cex = 1.25) + } + } + }) +} + +# This is the user-interface definition of a Shiny web application. +# You can find out more about building applications with Shiny here: +# +# http://shiny.rstudio.com +# + +ui <- fluidPage( + tags$head(includeScript('google-analytics.js')), + titlePanel("", windowTitle = "Tidy Up Data"), + sidebarLayout( + # Sidebar panel ==== + sidebarPanel( + conditionalPanel( + condition = 'input.conditionedSidePanels == 1', + fluidRow( + fileInput( + 'dataFile', + "Choose data file to upload", + accept = c( + 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet', + '.xlsx' + ) + ) + ), + fluidRow( + sliderInput( + 'interval', + "Averaging interval, min", + value = 1, min = 0.5, max = 10, step = 0.1 + ), + # numericInput('interval', 'Interval, min', 1, min = 0.5, max = 10, step = 0.1, width = '100px'), + bsTooltip( + 'interval', + "Interval that is used for lumping and averaging untidy data. Provided in minutes.", + 'right', options = list(container = 'body') + ) + ), + fluidRow( + downloadButton('downloadData', "Download") + ), + tags$hr(), + fluidRow( + selectInput('dataColumn', "Data to View", "OD680, AU") + ), + tags$hr() + ), + conditionalPanel( + condition = 'input.conditionedSidePanels == 2', + fluidRow( + sliderInput( + 'lagTime', + "Lag time, min", + value = 5, min = 0, max = 30, step = 1 + ), + bsTooltip( + 'lagTime', + "Length of lag time that defines part of data that are influenced by the dilution. Provided in minutes.", + 'right', + options = list(container = 'body') + ) + ) + ), + width = 3 + ), + # Main panel ==== + mainPanel( + tabsetPanel( + type = 'tabs', + tabPanel( + "Data Processing", + value = 1, + strong(textOutput('count')), + br(), + strong(textOutput('fileName')), + em(textOutput('fileSize')), + br(), + textOutput('dataDim'), + plotOutput('dataViewPlot', width = '90%') + ), + tabPanel( + "Data Analysis", + value = 2, + fluidRow( + column( + 4, + br(), + DT::dataTableOutput('dataProcessingTable') + ), + column( + 8, + plotOutput('dataProcessingPlot') + ) + ) + ), + id = 'conditionedSidePanels' + ), + width = 9 + ) + ), + # Bottom panel ==== + fluidRow( + column( + width = 3, + actionLink('register', label = "Register to support further development"), + tags$p(), + conditionalPanel( + 'input.register', + textInput('regName', label = "First name", value = "First name"), + textInput('regSurname', label = "Last name", value = "Last name"), + textInput('regEmail', label = "Email", value = "@"), + textInput('regOrganization', label = "Organization", value = "Organization"), + textInput('regDepartment', label = "Department", value = "Department"), + actionButton('regSend', label = "Send"), + tags$hr(), + p( + "@author CzechGlobe - Department of Adaptive Biotechnologies (JaCe)" + ), + p( + "@email cerveny.j@czechglobe.cz" + ) + ) + ), + column( + width = 7, + actionLink('help', label = "Help"), + conditionalPanel( + 'input.help', + p( + "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." + ), + p( + "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." + ) + ), + offset = 1 + ) + ), + fluidRow( + column( + 2, + tags$img(src = 'img/Logo-CzechGlobe.jpg', alt = "CzechGlobe", height = 60, align = 'top') + ), + column( + 1, + tags$img(src = 'img/Logo-C4Sys.jpg', alt = "C4Sys", height = 45, align = 'right') + ) + ) +) + +shinyApp(ui = ui, server = server) diff --git a/data/dataColumnNames.rds b/data/dataColumnNames.rds new file mode 100644 index 0000000000000000000000000000000000000000..f638ba7662de066c27f4565cb2f21d3fbef7a9e0 GIT binary patch literal 922 zcmV;L17-XliwFP!0000028EYNZ__{=#oeY*rAz3FT28)jiwz!cT(h(S38^dv$_Y8~ zq_N};d)$;;KN5TeJ{V=3%*0Fno*Zg>-W$*F*>dN#H#?FfZAz`J4QaDQFI&g+u_PVP zpDSrgYSZ(%GbUc>jTPU!osv|YpOn6zVK(6mobU;|%zpv;BqEN_W^_i5?}THl&T#HA z^>jSNL6j1QDDhNH@U7yEJ-5*uIVn$cgzrg})@yY7jn1Ia88YYjic@~7-H9Kllc4;n zc9>MWoW&%vI;s2yJGrv*-uDZ&w%*TQE9+6Im~Y_xT5n#%hK;y!Ts2(m z6NkTqn&sVjsTYNO#W;yZI910HQUdIHS-^}oGa^(I;wcmM;w*^im>w0LVk~AAfqnGXaE_FH5m;-MnjO%5M(q28BHLgxhA72$Y=^Onu3g` zAfp9jwAN&_1Q{(sMoW;<5@fW2jP{z0wjiS|$Y={P+O>?k@hnhN;w1@Am~@cNJVKi> zWm_2EHjl^@CqbkV9K<+rNS5$&IONX!q|hQ=-jXFF&z)CnzOUy_^$&y2`@DPPylJ{} zcEMX|q0+J`iO&||b>5C8x&1Bg`>q^tXlKA%UG5cKUsC%;$)8@_6P$#OFV7cG@CI8Dj&aBR-wbf zY+ns&n|I~jmqMT|UJ|y4SHr4LZ+KNS{gykp;$LRVU0!a+Z#nP-{TSutm$ewlgOy*0 z4s*WdU!tsmDgsptMIi(z6SC&kgtJ!4dkN=A2sq3$VVU_fqVq=^$K5aALdm>wkQVctmBMdftmzrP1e zKe?V44sDgpcSw{hJXUPiMfK1PDgTFbgIP~PC%`EyqD>}l-0+L<_32}}dGhHk{sPI! w|KU#f9!E#~$y|px>Lj6v+B)qdnyDPUpQ9h>;qmeD4?X?+51lr2u160507DX761xT|9{7S@d%W}4S+fr(S)x=?*unqi7!;}!LuFu z^kC4+^0alvb{FZZXPBBkW(41&31nlNag<|>EVweC44G6|S=RUjbvMc(g?jh4DQXdL zFm&}CP`2XY#n`H;9%o?@@G;?OYlj=90+MWMJLFh}R{6zC@J+CBc)Zrr=X#XTm%Hnc ziqt*=d*|C%KuSyKoc)CpXzOE`U(HNuT(!>DUx`77lDjV8IBMm|kg3Si=*iXF-Xu!2 z*iqN9OzP-EEinc}HKQyJFT*yra1cwe;#U-goENEeN14;Lx@ow*Z>5e1J(sy@V8=Gm zex;tl=S}7_J_C?353Rx}Wwsh|@8reKl^po?g>> zsqTAplCbN^`~V98JU%`J$oxYss}&hvoI_+y5~6j_AZn>?YiMD|@cPI3f9m*Otb>31 z^pY4U=?+GufMe0Sz}~CL#V9lZ2`7HhMluBtFR=yG>hN3&g2h%ULNo<@->2_9n?3IO z=NGxd_j<`L*H}wJF|fE^)Hsy}B;MFKz|p?6O%SmuS?xr3oV=L4OnxWsLhaZbNn2d^ zFgWUknYmSfzVOh`>oF>l;q@5T=&sv^FX2y{ z?u?{dhRxe^Z;&<#izSGQ*xtGY*pmkKz9aFZiLu+vNp4g;UbPpv?Wbv-KcycyKQ`Lv z>zQ1JaQfdO6G$grBnAoA$vZ> zf+9R`o6ZV4D^V1l2+$=&Kdam@I=LLW`!Hnl`C?2EV8|i|R4(AxG3}z5q0?mX=gMQp zAOsDOl~wD?%!Dve38MwBaz?db@1o0{;Uj4#q*YYsha2=?kOm-FC$*G1Tf(u5X+NcE zCrq6yP@94;-}Y&gfD`8yn`rbMhrNUv;CYw(1TT;wi?TpOU9*AC5AlXV`zwJzKh^~$ z!xkm(L3zQVZ^Hw8g}X4Cw3kDw50{dGL72R|UhAu*d@Xj36{|Q38&RJwX_}gDIu(R) zYgFnlfJnF=vFE~vV)T1ToJLrjHRJtcfxI)1$}MjW6!T<>z&$)13yiG767zZy+F3LQ zhd3IWY$65*>05N!scTCP{2l7q;iR7?#$+zKKJ(NFJy>DOC4Z^Dkz`2<$_; zx~;wnBcV-x8%6(^+6pN|U&7Jv2 zHZFWpq6b{d1nlQmI$p%GyF_$}I%9Y4{7DRmOa??qwK&WFaiYQ-IJ+{2NL(Bq0D$#} z)Y+Nn+8P?j+uNF28QcAsr@ki7TdlLB1sp#+CxU;{Tv;*$I>;((E^8*JYJ-|}thBs} zNqC;>C1fT>8_1)WnJulf$5{R7V6o!?Mq2_+tlMH8HNg|hQoe} z#CiQ6%e5z8kJsz5j=6SACWx#T7n{b(zJ|gW5O_X+{Pj{D{-IPSRnP!9?FQr+h;*yv zFi6L-;0r-L>!sh8EhH>%t^A1zNp>^;-4pkdIt6l9schabRo)_ej?DU2`I0W#lUb)2Zh@vGcSJ_1Y?y z{dG}ANFvzLsvz)Z!r|jCX3}B?Fe8}jIL641y~S&`B;)SUxjR$4vQ%<@pj4}XYT(dW zv%dJzwY13fmbT&C!O+RnzNrSp@vfr2HOOgbW^utNnXcaO^4v;@6I`sBsqs*E>VB)y z?`isu2U``Cg4>h5^fA}qg?~*$xdY}>#2xWV&pWUxhc!h@M?&ms>|hs2{e2PYHG?_gFL&?jD+1j49eJSzC85_Ir~{+ z7qg0Qw&;(;6LA&N{wPi%r=XEj5CjE6^s}(UIXNacZT)Iza&;)PGMin4CVy@;bN`#y z-B+clF2~fldAje4@U9cIwzp%KGf-NFwk9eGEW%RRY3g$w{PnlF^*SOh=4+xGaXLJXxe|C)h9LQ(z zSX^-jv3CD9hYmc+rm>I!BnO)pp54Md9I<_kE z?)jBt4e}#r%~_R~p8*OMYd7H@qo`94Sb*>z#__Pwqlx31hPS*uW?2X0YmL)8lf|%F zXWGjv3n!Z+ZFDkQ%kyohuw+7GkpBT!ub51~3jBB+fXe=)ZV`Tj51s880GZp2;1HFEX^3o|i`^3Db08vt5ABqT-;S;Rz><~er zK5EKg;$&eNXS+B?l%aSvLz%)3&+lhn<3r%*+C?i9n!FH}O=8>#c|d&{Rg2Q?#l`#? zysnO?-*)>tw55sPzHzy>TdK7+oYCa(ldN_9-l6R2epP?A&9L0+cIPm4Vah#y!r*bU z)&*{D?SC6q2j6uD&S-MJ+4x?o{cy6bA9@7}5qaY#syCQ!emzs)r}sR|pO-ifY{V3X z#zZdz-SX(Srx+1<#0_FtcB%FO!LfL0{q8MJemq;fc&-x%lP?W#NI!tT$L3gUSuqTW^ z`{IoE3OdB{bs%;A`?jm7APWlAgk6=Mi+V4~5k^Chrw_1pRzq61Np1YI&zG5r7U{(D zU`ZHY)%OL#u-#r_E~FP&Bc*9#7`rpl*JN?jwpNU~zQ-(Q$kA6(aB&t=SC&5E_L;As zYxy)B#D%?ksY1WT3=AYCAFs!N(3NPP&VfbWOUAHV+{abiK897yv)vG~E*@QLer<}y z*ynQCj0*sF+{48;2IBM~BQXqY4PNlq@xs^Mw&EUH9-n?6aL67dUFuTPEL~VHeRf5Y zea=Tuv$Sq@IIOFcf|Mm|N&9u!wmCZWopmx86KR27xW8L0`8q6Uhg85$Wkq?C-M-sy zn&oH^FVLaYOo>3xt-p5eE&ZB1d*5a8WYI#Z(OP>n^&H(p1JNZuxgcD)9%_x_XUA%m zYGp0-s2Z?rWLai+5YX8R>=U;4Z^mF6#+ z4+sG@3PEeZgYu3PW&NKdhwF{rt1}jAJt+%OQRIu>P1tB~aJIEqEo>IaN5)XAPo}71 z4jYBuo-8CuOEdnYE-a4xo*ApSHaly~q$N^A0v(u#%sLkD^K#f`9(j)^Ej)az=@6v5 zjGA~tXcjmC!;r(m$xRT->bkltqPj(c`?fQeens4#nJp-|tx!;G!Ey83^dui<9$AQb zHLTCK&y>?ps^4p)eLtj%bx+U`KYM$q78+*n_zW@A)c>N8+0(VG%HWyk6+bJ`QN%ua zNk~S|BbW9mCmCUcXOSu^74$I6w1Cpr<-%Z^M9q6X*-4qHh#hW$?_oKiF0jhv4f(l8 zQ%s{rr%Zx;9D>J-0N4}(p`aJ;kzxoNav zN_;;{rnIsXuky%T5+1)ghs8I=poykKuJTMNb`JO&zDg8YeXStd@{)aNVznP zRB2ya@p`W#@Bt!yM?TKyD_G9_Fv^8~45&0d!rG1zX??IwNYays6nk8b83N#B?UOy<%N`PBYOhVI z&igZk4oJFd(a^2!ok>*J+@FOC^4TB3Rr41w?ZM_LHM3B=G+R}EMf9~Q#Pthb%EG-F znp*MRC!{HxE)3Kf1t<8JJx^%LBH!gu&kIm4c4!hQn7w*~dTNLi#vL2Ujf1AuWqt+z zk0Bi=0GIs)64I@}0RYHQ2Rf1ax}!HDokF>+tZSI525Y&2kuqn5*Pb z3beI5txg}ilv1jsCInxz1J{~dSiqcN3~Iw^t~spnUdcWz?FoPL!kz5k&#SpJRNH9~BUSKY4 zU08}~thIA%7pYGx6Ir&_Wyi;<76Ei(Cn#OE~LWE=MT;4E?P-s2uWkxV)y;{|- z;jiyEd`=Bt;2)!=w1vd?R#mZzG_wA6b6#L5CPrHe5={^{?*XRtx;SEPx&ZqZ3KQ6! zg!4U6?`QJLOg_x7nd18QL-jpK^iNL5>!KuSd-%%9riaNHsqTa622DPFe5<4jn$6}2 zOkXCZLoRZVS^fTH?#&RaHYnR?YDd*d|6n2Geb@D9&Q{D=`i{%~%W40d>fM=E^3U7T z2Cggh2Cd@b65sh^#16R-SWWowxE#ey2%wNmk#O74D4AzCJ8mvz1i9erir-2)9WfL* zA(Hqorf@oIwy_T9(dx2?-J7bHbL26-i1*Hrv9GOt6q)*#DxtrEm}et)0zw?LAP6V! zfEuTP*H`D_ZBalio9{ zfonT9m3s$d!``I>4cmnZ`%{|jGFA3;A7wloE5lA$YY z0eF(t5zWz`N5s1*;lmeXmfD_3gg2$UQ8Da~HTsEqhytou~@R}%^|FZJjqt_iz`ym}aS#CY`oQsNS^|WzM zk`4@`Ial9c>oTq6f})|gMDrluaCSuF;X^}P%k8y$YihHSr7}mL;)>N59VMcEBTbSF zrFLyk9yb-}%1;a^`+C!aMT*~Y_k1F+cpvSrrm993Yl?306gcgRb>^>nHrDGk3;G+nN`)I$77py0%eNd93-V%_ z7Hf`moH)(j%rq;{Cr-!B;~t(3oCwYyM9Qp{FHPP@%8%*PFeEN#ph&56AL%SCYs$qP zS4)FmZeBUevTIiEg0mLfI7fGrz}vNUAMHJBKj}hq9#+=OmH0?oeRn~JJ-cn3fWFsM z1{1lw-4E^IEz(rHoWviNXYBayX^~>g>fy`lFH^yVS7so4d0~E$H+QJij%)4om?6+o zx9R&VRyf5tiIpUGXa8y@aH8ZD@d6TIY6xL06_`kh7+X1Le(e%*XB-kNp= z-YN&HIAI7yysfp;J$xEV((uHcbL;&gSeZW#uCk|SpTvwFd$2$86ZrBGDTgcZIS*kv zFVbUcv*&d;r7o=Oqr5&3VUKB$c4$jot9fcIo`wM@Q4bV@YOP;GV$YMOe8*I*nLJQ| zbM08IOO5t69G?CNbR!ufiQKih#wg|b>>HYy$XiSf(Lpk_0f`-Y63>&|RcOC_+<6^H znZU?+TPEoz%hW&!OZ9kT3Vrq*CzQVEJDyPieWii-EGj*&uEIIX;1?Z34PHoHMi*JR zu@S~+f>qkhXl(}_ca!dFl$nJ)?}oluz0%bo?y$O_eCsDW7MbD?oasg~CtTne)?OAQ zoI2gx+#j1wg0j*c(_Y)=E_!2V%7rO9diZn`U#Cbup_Zi`dXYyaC$tcxx;6}rWq->T z%#ik((#5a=VL-|H!|hUZdm zaMDbcblDISo5>l;CW&J7jSyz)Y10S>Xa zb3@yblHr-lypZUisyEwAazG^|Lkly%QK@cfQwYc|rp`Pg{X6?xp$ez8p57J@8bFX# zDO!Wr+6FhI?i>FZKSKLhp?X(lpi&ZMYLc&23@0#BAp(1=^W|1nDn-9$Y+vw~w9ZaQ zEpx?}%)l`ZM@A+p-N9rFB}ow07R8TRgL@mbD6~|Fb{Lp;qf!`~R$UuHx*)wGT zm_}?I0#s_*q}U_~II~E-Iur2E8{5);_P}50kPZ%@Y8cw)Fj6rw!7WnA+Q$ES6)V)I z__6@ePVOf-!`J1?a%T1 z(Xcs3ywqSHo}Fl|BTuBlF!om4I%UG`3>IxYG++wfm{b`Ml^O-%Rv`xDyRZQpFE_GW zB{h1vq%#*w*mRT?_w9`9Ms5Sj?Ds z2jg@9W0>XajTWgnpW#u*tcqtgq@1!%&-z+RXFiYx?_Z*{#3p?7!ap!4DWOrRhvt-_w`kn3|L>;_kAg7(byX9UD%;z(?N7t9}lPLlPzvtiztgv&6zJH%Fs1*icV$T>))Ve{0FZ z?rf|4p~n~AjdczeNFBL5d7&2&;@7!NmV8|u#6T@(8pBFDOgXv^eXIkC)HaJH)?z^N>O|J(C5a4`d1l{9@z4gR3F3wxC9jcy^@Ek=1 zdspA2#W+o&Ez3Pxv%d>N#@0r`X^J_^)@yh*lX$T6QG#;2bWUwucc{IAiI~5SgMZN% zFQJC%b*|Fe()VRpcHT$v(~hq~sC*e$6mmFbllj8fX7Y_n+y(k?lm|ylUh z>YcP2Bi{q@>*`oho?ybGzD9S7;9eOq(r3Q+bp}!qMYLYNT{iLu`IaucGL32oVl8pf+cKv?pJAU}b61<6JI=WSrW829V?A2x-_Ncsb{`YnD-vNGK#`p{13(g;1_0|2Na1pxkKUwweQng9R* literal 0 HcmV?d00001 diff --git a/mlabDB-connect.R b/mlabDB-connect.R deleted file mode 100644 index 5a3d11e..0000000 --- a/mlabDB-connect.R +++ /dev/null @@ -1,2 +0,0 @@ -mLab <- list("insert") -mLab$insert <- function(data){} \ No newline at end of file diff --git a/server.R b/server.R deleted file mode 100644 index 3cebea1..0000000 --- a/server.R +++ /dev/null @@ -1,243 +0,0 @@ -# This is the server logic for a Shiny web application. -# You can find out more about building applications with Shiny here: -# -# http://shiny.rstudio.com -# - -options( shiny.maxRequestSize = 12 * 1024 ^ 2 ) -options( java.parameters = "-Xmx4g" ) - -library(data.table) -library(DT) -library(dplyr) -library(dtplyr) -library(mongolite) -library(shiny) -library(shinyBS) -library(tidyr) -library(xlsx) - -source("mlabDB-connect.R", echo = FALSE) - -shinyServer(function(input, output, session) { - observeEvent(input$send, { - mLab$insert( - data.frame( - Sys.Date(), - 'User', - input$name, - input$surname, - input$email, - input$organization, - input$department - ) - ) - updateActionButton( - session, 'send', - label = 'Successfully Sent!' - ) - }, - ignoreNULL = TRUE - ) -# File input ==== - dataInput <- reactive({ - if (is.null(input$datafile)) - return(NULL) - withProgress(message = 'Processing uploaded data...', value = 0.4, { - if (input$datafile$type == 'application/x-zip-compressed') { - fileunz = unzip(input$datafile$datapath) - untidydata <- read.table( - fileunz, - header = input$header, - sep = input$sep, - dec = input$dec - ) - } - else if ( - input$datafile$type == - 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet') { - fileunz <- input$datafile$datapath - untidydata <- data.table( - read.xlsx2( - fileunz, - sheetName = 'Data' - ) - ) - incProgress(0.4) - as.numeric.factor <- function(x) {as.numeric(levels(x))[x]} - datacolnames <- colnames(untidydata) - untidydata[, (datacolnames) := lapply(.SD, as.numeric.factor), - .SDcols = datacolnames] - } - else { - fileunz <- input$datafile$datapath - untidydata <- read.table( - fileunz, - header = input$header, - sep = input$sep, - dec = input$dec - ) - } - }) - mLab$insert( - data.frame( - Sys.Date(), - 'File', - input$datafile$name, - input$datafile$type, - input$datafile$size, - input$datafile$datapath - ) - ) - if (input$datafile$type == 'application/x-zip-compressed') - file.remove(fileunz) - return(untidydata) - }) -# Data processing ==== - dataProcessed <- reactive({ - factor <- 3600 / (input$interval * 60) - untidydata <- dataInput() - if (is.null(untidydata)) return(NULL) - untidydata$time <- round(untidydata$time * factor) / factor - as.data.frame.list(untidydata) %>% fill(2:length(.)) %>% group_by(time) %>% - summarize_all(funs(mean)) %>% arrange(time) - }) - -# Processed file download ==== - output$downloadData <- downloadHandler( - # This function returns a string which tells the client - # browser what name to use when saving the file. - filename = function() { - if (input$datafile$type == - 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet') - paste(input$datafile$name) - else { - filetype <- - switch(input$sep, - ";" = "csv", - "," = "csv", - "\t" = "tsv") - paste('TidyData', filetype, sep = '.') - } - } - , - # This function should write data to a file given to it by - # the argument 'file'. - content = function(file) { - # Write to a file specified by the 'file' argument - if (input$datafile$type == - 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet') { - withProgress( - message = 'Writing processed data...', - value = 0.4, - { - write.xlsx2( - data.frame(dataProcessed()), - input$datafile$datapath, - sheetName = 'TidyData', - row.names = FALSE, - append = TRUE, - showNA = TRUE - ) - incProgress(0.4) - file.copy(input$datafile$datapath, file) - }) - } - else { - write.table( - dataProcessed(), - file = file, - sep = input$sep, - dec = input$dec, - row.names = FALSE - ) - } - } - ) -# Growth Rates calculataion ==== - growthRates <- reactive({ - withProgress( - message = 'Calculating growth rates...', - value = 0.0, - { - data <- data.frame(dataProcessed()) - pumpon <- which(data[, 'pumps.pump.5'] > 0) - expfitstart <- c() - expfitstop <- c() - time <- c() - TD <- c() - R2 <- c() - for (i in 2:(length(pumpon) - 1)) { - if (data[pumpon[i] - 1, 'pumps.pump.5'] == 0) expfitstop <- c(expfitstop, pumpon[i]) - else if (data[pumpon[i] + 1, 'pumps.pump.5'] == 0) expfitstart <- c(expfitstart, pumpon[i] + 1) - } - incProgress(0.15) - for (j in 1:length(expfitstart)) { - # interval <- c((expfitstop[j] - ceiling(expfitstop[j] - expfitstart[j]) * (1 - input$lag)):expfitstop[j]) - interval <- c((expfitstart[j] + ceiling(input$lag/input$interval)):expfitstop[j]) - timefit <- data[interval, 'time'] - datafit <- data[interval, 'od.sensors.od.680'] - fit <- nls(datafit ~ exp(a + b * timefit), - start = list(a = 0, b = 0.5), - control = list(maxiter = 99, warnOnly = TRUE)) - time <- c(time, timefit[length(timefit)]) - R2 <- c(R2, cor(datafit,predict(fit))) - TD <- c(TD, 1/coef(fit)[2]*log(2)) - incProgress(0.15 + (j/length(expfitstart))*0.85) - } - }) - return(data.frame(time, TD, R2)) - }) -# UI outputs hadling ==== - output$filename <- renderText({ - if (!is.null(input$datafile$name)) - paste('Uploaded file name is ', input$datafile$name) - }) - output$filesize <- renderText({ - if (!is.null(input$datafile$size)) - paste('Uploaded file size is ', - round(input$datafile$size / 1024), - ' kB') - }) - output$inputdim <- renderText({ - if (!is.null(input$datafile$size)) - paste( - 'Uploaded/processed table dimensions are ', - dim(dataInput())[1], - '/', - dim(dataProcessed())[1], - ' x ', - dim(dataInput())[2], - '/', - dim(dataProcessed())[2], - ' (rows x cols)' - ) - }) - output$dataViewPlot <- renderPlot({ - if (!is.null(dataProcessed())) - plot(x = dataProcessed()$time, y = dataProcessed()$od.sensors.od.680, xlab = 'Experiment duration, h', ylab = 'Optical density, AU') - }) - # https://rstudio.github.io/DT/options.html - # https://datatables.net/reference/option/dom - output$dataProcessingTable <- DT::renderDataTable({ - if (!is.null(dataProcessed())) - datatable(growthRates(), options = list(dom = 'tlp', pageLength = 8, lengthChange = FALSE, seraching = FALSE)) %>% formatRound( - c('time','TD','R2'), - digits = 2 - )}, - server = FALSE - ) - output$dataProcessingPlot <- renderPlot({ - if (!is.null(dataProcessed())) { - s1 = NULL - s2 = input$dataProcessingTable_rows_selected - plot(x = growthRates()$time, y = growthRates()$TD, xlab = 'Experiment duration, h', ylab = 'Doubling time, h') - if (length(s1)) { - points(growthRates()[s1, , drop = FALSE], pch = 19, cex = 1, col = 'green') - } - if (length(s2)) { - points(growthRates()[s2, , drop = FALSE], pch = 19, cex = 1.25) - } - } - }) -}) diff --git a/ui.R b/ui.R deleted file mode 100644 index 4784fef..0000000 --- a/ui.R +++ /dev/null @@ -1,199 +0,0 @@ -# This is the user-interface definition of a Shiny web application. -# You can find out more about building applications with Shiny here: -# -# http://shiny.rstudio.com -# - -library(data.table) -library(DT) -library(dplyr) -library(dtplyr) -library(mongolite) -library(shiny) -library(shinyBS) -library(tidyr) -library(xlsx) - -shinyUI(fluidPage( - tags$head(includeScript('google-analytics.js')), - titlePanel('', windowTitle = 'Tidy Up Data'), - sidebarLayout( - # Sidebar panel ==== - sidebarPanel( - conditionalPanel( - condition = 'input.conditionedSidePanels==1', - fluidRow( - fileInput( - 'datafile', - 'Choose data file to upload', - accept = c( - 'application/x-zip-compressed', - 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet', - 'text/csv', - 'text/comma-separated-values', - 'text/tab-separated-values', - 'text/plain', - '.xlsx', - '.csv', - '.tsv' - ) - ) - ), - fluidRow( - sliderInput( - 'interval', - 'Averaging interval, min', - value = 1, min = 0.5, max = 10, step = 0.1 - ), - # numericInput('interval', 'Interval, min', 1, min = 0.5, max = 10, step = 0.1, width = '100px'), - bsTooltip( - 'interval', - 'Interval that is used for lumping and averaging untidy data. Provided in minutes.', - 'right', options = list(container = 'body') - ) - ), - fluidRow( - downloadButton('downloadData', 'Download') - ), - tags$hr(), - fluidRow( - column( - width = 6, - 'Plain text data:' - ), - column( - width = 6, - checkboxInput('header', 'Header', TRUE) - ) - ), - fluidRow( - column( - width = 6, - radioButtons( - 'sep', - 'Separator', - c( - Comma = ',', - Semicolon = ';', - Tab = '\t' - ), - ',' - ) - ), - column( - width = 6, - radioButtons( - 'dec', - 'Decimal', - c('Point' = '.', - 'Comma' = ','), - '.' - ) - ) - ) - ), - conditionalPanel( - condition = 'input.conditionedSidePanels==2', - fluidRow( - sliderInput( - 'lag', - 'Lag time, min', - value = 5, min = 0, max = 30, step = 1 - ), - bsTooltip( - 'lag', - 'Length of lag time that defines part of data that are influenced by the dilution. Provided in minutes.', - 'right', - options = list(container = 'body') - ) - ) - ), - width = 3 - ), - # Main panel ==== - mainPanel( - tabsetPanel( - type = 'tabs', - tabPanel( - 'Data Processing', - value = 1, - strong(textOutput("count")), - br(), - strong(textOutput("filename")), - em(textOutput("filesize")), - br(), - textOutput('inputdim'), - plotOutput('dataViewPlot', width = '90%') - ), - tabPanel( - 'Data Analysis', - value = 2, - fluidRow( - column( - 4, - br(), - DT::dataTableOutput('dataProcessingTable') - ), - column( - 8, - plotOutput('dataProcessingPlot') - ) - ) - ), - id = 'conditionedSidePanels' - ), - width = 9 - ) - ), - # Bottom panel ==== - fluidRow( - column( - width = 3, - actionLink('register', label = 'Register to support further development'), - tags$p(), - conditionalPanel( - 'input.register', - textInput("name", label = "First name", value = "First name"), - textInput("surname", label = "Last name", value = "Last name"), - textInput("email", label = "Email", value = "@"), - textInput("organization", label = "Organization", value = "Organization"), - textInput("department", label = "Department", value = "Department"), - actionButton("send", label = "Send"), - tags$hr(), - p( - '@author CzechGlobe - Department of Adaptive Biotechnologies (JaCe)' - ), - p( - "@email cerveny.j@czechglobe.cz" - ) - ) - ), - column( - width = 7, - actionLink("help", label = "Help"), - conditionalPanel( - "input.help", - p( - "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) or plain text tabular data CSV (or TSV) format." - ), - p( - "For PSI photobioreactor software expoerted data, the most simple untidy data preparation procedure is to export data from the software in ODS format and then either save the file as .xlsx Excel format or export the last sheet (Data) as CSV file." - ), - p( - "In general this tool can be used on any numeric data table, e.g. for large datasets tidying up, averaging, etc." - ) - ), - offset = 1 - ) - ), - fluidRow( - column( - 2, - tags$img(src = "img/Logo-CzechGlobe.jpg", alt = "CzechGlobe", height = 60, align = "top") - ), - column( - 1, - tags$img(src = "img/Logo-C4Sys.jpg", alt = "C4Sys", height = 45, align = "right") - ) - ) -)) From 9aae160f67f3bc07690b318e9dc505ad3d61cfa5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20=C4=8Cerven=C3=BD?= Date: Wed, 9 Aug 2017 17:16:47 -0400 Subject: [PATCH 3/5] Added graph zooming funcionality -Added double click to zoom on selected range -Added posibilty to dowload analysis (growth rates calculations) --- app.R | 79 +++++++++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 74 insertions(+), 5 deletions(-) diff --git a/app.R b/app.R index bf152ab..25fe32e 100644 --- a/app.R +++ b/app.R @@ -20,6 +20,8 @@ source('DB-connect.R', echo = FALSE) dataColumnNames <- readRDS('data/dataColumnNames.rds') server <- function(input, output, session) { + rangesView <- reactiveValues(x = NULL, y = NULL) + rangesProcessing <- reactiveValues(x = NULL, y = NULL) observeEvent(input$send, { updateActionButton( session, 'regSend', @@ -28,6 +30,26 @@ server <- function(input, output, session) { }, ignoreNULL = TRUE ) + observeEvent(input$dataViewPlot_dblClick, { + brush <- input$dataViewPlot_brush + if (!is.null(brush)) { + rangesView$x <- c(brush$xmin, brush$xmax) + rangesView$y <- c(brush$ymin, brush$ymax) + } else { + rangesView$x <- NULL + rangesView$y <- NULL + } + }) + observeEvent(input$dataProcessingPlot_dblClick, { + brush <- input$dataProcessingPlot_brush + if (!is.null(brush)) { + rangesProcessing$x <- c(brush$xmin, brush$xmax) + rangesProcessing$y <- c(brush$ymin, brush$ymax) + } else { + rangesProcessing$x <- NULL + rangesProcessing$y <- NULL + } + }) # File input ==== dataInput <- reactive({ if (is.null(input$dataFile) || (input$dataFile$type != 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet')) { @@ -87,6 +109,37 @@ server <- function(input, output, session) { } } ) +# Analysis file download ==== + output$downloadAnalysis <- downloadHandler( + # This function returns a string which tells the client + # browser what name to use when saving the file. + filename = function() { + paste(input$dataFile$name) + } + , + # This function should write data to a file given to it by + # the argument 'file'. + content = function(file) { + # Write to a file specified by the 'file' argument + if (input$dataFile$type == + 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet') { + withProgress( + message = "Writing processed data...", + value = 0.4, + { + pbrDataFile <- loadWorkbook(file = input$dataFile$datapath) + addWorksheet(pbrDataFile, 'TidyData') + writeData(pbrDataFile, 'TidyData', dataProcessed()) + addWorksheet(pbrDataFile, 'Analysis') + writeData(pbrDataFile, 'Analysis', growthRates()) + saveWorkbook(pbrDataFile, input$dataFile$datapath, overwrite = TRUE) + incProgress(0.4) + file.copy(input$dataFile$datapath, file) + } + ) + } + } + ) # Growth Rates calculataion ==== growthRates <- reactive({ withProgress( @@ -147,7 +200,7 @@ server <- function(input, output, session) { output$dataViewPlot <- renderPlot({ data <- dataProcessed() if (!is.null(data)) { - plot(x = data$time, y = data[[dataColumnNames$X[match(input$dataColumn, dataColumnNames$Y)]]], xlab = 'Experiment duration, h', ylab = 'Optical density, AU') + plot(x = data$time, y = data[[dataColumnNames$X[match(input$dataColumn, dataColumnNames$Y)]]], xlim = rangesView$x, ylim = rangesView$y, xlab = 'Experiment duration, h', ylab = 'Optical density, AU') } }) @@ -166,7 +219,7 @@ server <- function(input, output, session) { s1 = NULL s2 = input$dataProcessingTable_rows_selected gRates <- growthRates() - plot(x = gRates$time, y = gRates$Dt, xlab = "Experiment duration, h", ylab = "Doubling time, h") + plot(x = gRates$time, y = gRates$Dt, xlim = rangesProcessing$x, ylim = rangesProcessing$y, xlab = "Experiment duration, h", ylab = "Doubling time, h") if (length(s1)) { points(gRates[s1, , drop = FALSE], pch = 19, cex = 1, col = 'green') } @@ -185,7 +238,7 @@ server <- function(input, output, session) { ui <- fluidPage( tags$head(includeScript('google-analytics.js')), - titlePanel("", windowTitle = "Tidy Up Data"), + titlePanel("", windowTitle = "PBR Data Analysis"), sidebarLayout( # Sidebar panel ==== sidebarPanel( @@ -237,6 +290,9 @@ ui <- fluidPage( 'right', options = list(container = 'body') ) + ), + fluidRow( + downloadButton('downloadAnalysis', "Download") ) ), width = 3 @@ -254,7 +310,14 @@ ui <- fluidPage( em(textOutput('fileSize')), br(), textOutput('dataDim'), - plotOutput('dataViewPlot', width = '90%') + plotOutput('dataViewPlot', + width = '90%', + dblclick = 'dataViewPlot_dblClick', + brush = brushOpts( + id = 'dataViewPlot_brush', + resetOnNew = TRUE + ) + ) ), tabPanel( "Data Analysis", @@ -267,7 +330,13 @@ ui <- fluidPage( ), column( 8, - plotOutput('dataProcessingPlot') + plotOutput('dataProcessingPlot', + dblclick = 'dataProcessingPlot_dblClick', + brush = brushOpts( + id = 'dataProcessingPlot_brush', + resetOnNew = TRUE + ) + ) ) ) ), From 8cd75f2274228810bccca99621fe1e48f1089fea Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20=C4=8Cerven=C3=BD?= Date: Wed, 9 Aug 2017 20:45:35 -0400 Subject: [PATCH 4/5] Cosmetics on UI Small changes in UI --- app.R | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/app.R b/app.R index 25fe32e..3a0b77d 100644 --- a/app.R +++ b/app.R @@ -68,7 +68,7 @@ server <- function(input, output, session) { return(NULL) } selectChoices <- merge(data.frame(X = colnames(untidyData)), dataColumnNames) - updateSelectInput(session, 'dataColumn', choices = selectChoices$Y, selected = 'OD680, AU') + updateSelectInput(session, 'selectDataView', choices = selectChoices$Y, selected = 'OD680, AU') factor <- 3600 / (input$interval * 60) untidyData$time <- round(untidyData$time * factor) / factor untidyData %>% @@ -200,7 +200,7 @@ server <- function(input, output, session) { output$dataViewPlot <- renderPlot({ data <- dataProcessed() if (!is.null(data)) { - plot(x = data$time, y = data[[dataColumnNames$X[match(input$dataColumn, dataColumnNames$Y)]]], xlim = rangesView$x, ylim = rangesView$y, xlab = 'Experiment duration, h', ylab = 'Optical density, AU') + plot(x = data$time, y = data[[dataColumnNames$X[match(input$selectDataView, dataColumnNames$Y)]]], xlim = rangesView$x, ylim = rangesView$y, xlab = 'Experiment duration, h', ylab = 'Optical density, AU') } }) @@ -267,14 +267,14 @@ ui <- fluidPage( 'right', options = list(container = 'body') ) ), + tags$hr(), fluidRow( - downloadButton('downloadData', "Download") + selectInput('selectDataView', "Data to view", "OD680, AU") ), tags$hr(), fluidRow( - selectInput('dataColumn', "Data to View", "OD680, AU") - ), - tags$hr() + downloadButton('downloadData', "Download") + ) ), conditionalPanel( condition = 'input.conditionedSidePanels == 2', @@ -291,6 +291,14 @@ ui <- fluidPage( options = list(container = 'body') ) ), + tags$hr(), + fluidRow( + selectInput('selectGrowthRatesData', "Data for growth calculation", c("OD680, AU", "OD720, AU"), "OD680, AU") + ), + fluidRow( + selectInput('selectDilutionPump', "Pump used for dilutions", c("Turbidostat", "Pump 3", "Pump 4", "Pump 5", "Pump 6", "Pump 7"), "Pump 5") + ), + tags$hr(), fluidRow( downloadButton('downloadAnalysis', "Download") ) From 9b42d5fa26f0e2f96d0064aa79cba0e79ca8712d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20=C4=8Cerven=C3=BD?= Date: Sun, 3 Sep 2017 20:34:00 +0200 Subject: [PATCH 5/5] Major update DB -new DB for registration Data Processing -empty columns filtering -download limited (time) range data File processing -fixed downloading error after already downloaded files -check for existing sheets Plots -fixed zooming feature -second axes in graphs -added empty secondary axes in selection Analysis -added selection for turbi pump -added check for growth section (data points) length -regression parametrers adjustment --- DB-connect.R | 1 - app.R | 244 +++++++++++++++++++++++++++++++++++---------------- dbRegister.R | 0 3 files changed, 169 insertions(+), 76 deletions(-) delete mode 100644 DB-connect.R create mode 100644 dbRegister.R diff --git a/DB-connect.R b/DB-connect.R deleted file mode 100644 index 7affb73..0000000 --- a/DB-connect.R +++ /dev/null @@ -1 +0,0 @@ -# con <- dbConnect(RMySQL::MySQL(), dbname = NULL, username = 'DoAB', password = 'VT16Drasov', host = 'gcri-doab-ext.diskstation.me', port = 33633) diff --git a/app.R b/app.R index 3a0b77d..fcfc0e3 100644 --- a/app.R +++ b/app.R @@ -7,22 +7,21 @@ options(shiny.maxRequestSize = 12 * 1024 ^ 2) library(dplyr) -library(dtplyr) library(DT) library(openxlsx) +library(plotrix) library(shiny) library(shinyBS) library(RMySQL) library(tidyr) -source('DB-connect.R', echo = FALSE) - dataColumnNames <- readRDS('data/dataColumnNames.rds') - +# SERVER Part ==== server <- function(input, output, session) { rangesView <- reactiveValues(x = NULL, y = NULL) rangesProcessing <- reactiveValues(x = NULL, y = NULL) - observeEvent(input$send, { + observeEvent(input$regSend, { + source('dbRegister.R', local = TRUE, echo = FALSE) updateActionButton( session, 'regSend', label = "Successfully Sent!" @@ -35,9 +34,15 @@ server <- function(input, output, session) { if (!is.null(brush)) { rangesView$x <- c(brush$xmin, brush$xmax) rangesView$y <- c(brush$ymin, brush$ymax) + output$downloadSize <- renderText({ + paste0("Data time range reduced to: ", floor(rangesView$x[1]), " to ", ceiling(rangesView$x[2]), " h") + }) } else { rangesView$x <- NULL rangesView$y <- NULL + output$downloadSize <- renderText({ + paste0("") + }) } }) observeEvent(input$dataProcessingPlot_dblClick, { @@ -50,40 +55,30 @@ server <- function(input, output, session) { rangesProcessing$y <- NULL } }) -# File input ==== + # File processing ==== + # Upload dataInput <- reactive({ - if (is.null(input$dataFile) || (input$dataFile$type != 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet')) { + if (is.null(input$dataFile) || (input$dataFile$type != + 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet')) { return(NULL) } - withProgress(message = "Processing uploaded data...", value = 0.4, { - untidyData <- readWorkbook(input$dataFile$datapath, sheet = 'Data') - incProgress(0.4) - }) + withProgress( + message = "Processing uploaded data...", + value = 0.4, + { + untidyData <- readWorkbook(input$dataFile$datapath, sheet = 'Data') + incProgress(0.4) + } + ) return(untidyData) }) -# Data processing ==== - dataProcessed <- reactive({ - untidyData <- dataInput() - if (is.null(untidyData)) { - return(NULL) - } - selectChoices <- merge(data.frame(X = colnames(untidyData)), dataColumnNames) - updateSelectInput(session, 'selectDataView', choices = selectChoices$Y, selected = 'OD680, AU') - factor <- 3600 / (input$interval * 60) - untidyData$time <- round(untidyData$time * factor) / factor - untidyData %>% - fill(2:length(.)) %>% - group_by(time) %>% - summarize_all(mean) %>% - arrange(time) - }) -# Processed file download ==== + # Download - TidyData output$downloadData <- downloadHandler( # This function returns a string which tells the client # browser what name to use when saving the file. filename = function() { if (input$dataFile$type == - 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet') { + 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet') { paste(input$dataFile$name) } } @@ -93,23 +88,30 @@ server <- function(input, output, session) { content = function(file) { # Write to a file specified by the 'file' argument if (input$dataFile$type == - 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet') { + 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet') { withProgress( message = "Writing processed data...", value = 0.4, { pbrDataFile <- loadWorkbook(file = input$dataFile$datapath) - addWorksheet(pbrDataFile, 'TidyData') - writeData(pbrDataFile, 'TidyData', dataProcessed()) - saveWorkbook(pbrDataFile, input$dataFile$datapath, overwrite = TRUE) + if (is.na(match('TidyData', getSheetNames(file = input$dataFile$datapath)))) { + addWorksheet(pbrDataFile, 'TidyData') + } + if (!is.null(rangesView$x)) { + tidyData <- dataProcessed() %>% filter(.$time > floor(rangesView$x[1])) %>% filter(.$time < ceiling(rangesView$x[2])) + } else { + tidyData <- dataProcessed() + } + writeData(pbrDataFile, 'TidyData', tidyData) + saveWorkbook(pbrDataFile, paste0(input$dataFile$datapath, '-tempDW'), overwrite = TRUE) incProgress(0.4) - file.copy(input$dataFile$datapath, file) + file.copy(paste0(input$dataFile$datapath, '-tempDW'), file) } ) } } ) -# Analysis file download ==== + # Download - Analysis output$downloadAnalysis <- downloadHandler( # This function returns a string which tells the client # browser what name to use when saving the file. @@ -128,53 +130,101 @@ server <- function(input, output, session) { value = 0.4, { pbrDataFile <- loadWorkbook(file = input$dataFile$datapath) - addWorksheet(pbrDataFile, 'TidyData') + if (is.na(match('TidyData', getSheetNames(file = input$dataFile$datapath)))) { + addWorksheet(pbrDataFile, 'TidyData') + } writeData(pbrDataFile, 'TidyData', dataProcessed()) - addWorksheet(pbrDataFile, 'Analysis') + if (is.na(match('Analysis', getSheetNames(file = input$dataFile$datapath)))) { + addWorksheet(pbrDataFile, 'Analysis') + } writeData(pbrDataFile, 'Analysis', growthRates()) - saveWorkbook(pbrDataFile, input$dataFile$datapath, overwrite = TRUE) + saveWorkbook(pbrDataFile, paste0(input$dataFile$datapath, '-tempDA'), overwrite = TRUE) incProgress(0.4) - file.copy(input$dataFile$datapath, file) + file.copy(paste0(input$dataFile$datapath, '-tempDA'), file) } ) } } ) -# Growth Rates calculataion ==== + # Data processing ==== + dataProcessed <- reactive({ + # Read data and remove empty columns + untidyData <- Filter(function(x)!all(is.na(x)), dataInput()) + if (is.null(untidyData)) { + return(NULL) + } + selectChoices <- merge(data.frame(X = colnames(untidyData)), dataColumnNames) + if(input$selectDataView == "") { + selected <- "OD680, AU" + } else { + selected = input$selectDataView + } + if(input$selectDataView2 == "" || input$selectDataView2 == "-") { + selected2 <- "-" + } else { + selected2 = input$selectDataView2 + } + updateSelectInput(session, 'selectDataView', choices = selectChoices$Y, selected = selected) + updateSelectInput(session, 'selectDataView2', choices = c("-", selectChoices$Y), selected = selected2) + if (input$interval > 0) { + factor <- 3600 / (input$interval * 60) + untidyData$time <- round(untidyData$time * factor) / factor + untidyData %>% + fill(eval(2 : ncol(.))) %>% + group_by(time) %>% + summarize_all(mean) %>% + arrange(time) + } else { + untidyData %>% fill(eval(2 : ncol(.))) + } + }) + # Growth rates calculation growthRates <- reactive({ + data <- dataProcessed() + pumps <- grep('pumps.pump-.$', colnames(data), value = TRUE) + if (length(pumps) < 1) { + return(data.frame(time = c(0), mu = c(0), R2 = c(0), Dt = c(0))) + } + columnName <- dataColumnNames$X[match(input$selectDilutionPump, dataColumnNames$Y)] + if(is.null(data[[columnName]]) || (sum(data[[columnName]], na.rm = TRUE) == 0)) { + return(data.frame(time = c(0), mu = c(0), R2 = c(0), Dt = c(0))) + } withProgress( message = "Calculating growth rates...", value = 0.0, { - data <- dataProcessed() - pumpOn <- which(data$`pumps.pump-5` > 0) + pumpOn <- which(data[[columnName]] > 0) expFitStart <- c() expFitStop <- c() time <- c() - Dt <- c() + mu <- c() R2 <- c() + Dt <- c() for (i in 2:(length(pumpOn) - 1)) { - if (data$`pumps.pump-5`[pumpOn[i] - 1] == 0) expFitStop <- c(expFitStop, pumpOn[i]) - else if (data$`pumps.pump-5`[pumpOn[i] + 1] == 0) expFitStart <- c(expFitStart, pumpOn[i] + 1) + if (data[[columnName]][pumpOn[i] - 1] == 0) expFitStop <- c(expFitStop, pumpOn[i]) + else if (data[[columnName]][pumpOn[i] + 1] == 0) expFitStart <- c(expFitStart, pumpOn[i] + 1) } incProgress(0.15) for (j in 1:length(expFitStart)) { - # interval <- c((expFitStop[j] - ceiling(expFitStop[j] - expFitStart[j]) * (1 - input$lagTime)):expFitStop[j]) - interval <- c((expFitStart[j] + ceiling(input$lagTime/input$interval)):expFitStop[j]) + interval <- c((expFitStart[j] + floor(input$lagTime/input$interval)):expFitStop[j]) + incProgress(0.15 + (j / length(expFitStart)) * 0.85) + if (length(interval) < 4) { + next + } timeFit <- data$time[interval] - dataFit <- data$`od-sensors.od-680`[interval] + dataFit <- data[[dataColumnNames$X[match(input$selectGrowthRatesData, dataColumnNames$Y)]]][interval] fit <- nls(dataFit ~ exp(a + b * timeFit), - start = list(a = 0, b = 0.5), - control = list(maxiter = 99, warnOnly = TRUE)) + start = list(a = 0, b = 0.1), + control = list(maxiter = 99, minFactor = 1/2048, warnOnly = TRUE)) time <- c(time, timeFit[length(timeFit)]) + mu <- c(mu, coef(fit)[2] * 24) R2 <- c(R2, cor(dataFit, predict(fit))) Dt <- c(Dt, 1 / coef(fit)[2] * log(2)) - incProgress(0.15 + (j / length(expFitStart)) * 0.85) } }) - return(data.frame(time, Dt, R2)) + return(data.frame(time, mu, R2, Dt)) }) -# UI outputs hadling ==== + # Outputs hadling ==== output$fileName <- renderText({ if (!is.null(input$dataFile$name)) paste("Uploaded file name is ", input$dataFile$name) @@ -194,24 +244,54 @@ server <- function(input, output, session) { dim(dataProcessed())[1], " x ", dim(dataInput())[2], + "/", + dim(dataProcessed())[2], " (rows x cols)" ) }) output$dataViewPlot <- renderPlot({ data <- dataProcessed() if (!is.null(data)) { - plot(x = data$time, y = data[[dataColumnNames$X[match(input$selectDataView, dataColumnNames$Y)]]], xlim = rangesView$x, ylim = rangesView$y, xlab = 'Experiment duration, h', ylab = 'Optical density, AU') + if(input$selectDataView2 == "" || input$selectDataView2 == "-") { + plot(x = data$time, + y = data[[dataColumnNames$X[match(input$selectDataView, dataColumnNames$Y)]]], + xlim = rangesView$x, + ylim = rangesView$y, + xlab = 'Experiment duration, h', + ylab = input$selectDataView) + } else { + if (!is.null(rangesView$y)) { + ymin = min(data[[dataColumnNames$X[match(input$selectDataView, dataColumnNames$Y)]]], na.rm = TRUE) + ymax = max(data[[dataColumnNames$X[match(input$selectDataView, dataColumnNames$Y)]]], na.rm = TRUE) + y2min = min(data[[dataColumnNames$X[match(input$selectDataView2, dataColumnNames$Y)]]], na.rm = TRUE) + y2max = max(data[[dataColumnNames$X[match(input$selectDataView2, dataColumnNames$Y)]]], na.rm = TRUE) + y2lim <- c((rangesView$y[1] - ymin) / (ymax - ymin) * (y2max - y2min) + y2min, y2max - (ymax - rangesView$y[2]) / (ymax - ymin) * (y2max - y2min)) + } else { + y2lim <- NULL + } + twoord.plot(lx = data$time, + ly = data[[dataColumnNames$X[match(input$selectDataView, dataColumnNames$Y)]]], + rx = data$time, + ry = data[[dataColumnNames$X[match(input$selectDataView2, dataColumnNames$Y)]]], + xlim = rangesView$x, + lylim = rangesView$y, + rylim = y2lim, + xlab = 'Experiment duration, h', + ylab = input$selectDataView, + rylab = input$selectDataView2, + rcol = 3, + rpch = 1) + } } }) - # https://rstudio.github.io/DT/options.html # https://datatables.net/reference/option/dom output$dataProcessingTable <- DT::renderDataTable({ if (!is.null(dataProcessed())) datatable(growthRates(), - options = list(dom = 'tlp', pageLength = 8, lengthChange = FALSE, searching = FALSE)) %>% - formatRound(c('time','Dt','R2'), digits = 2) - }, + options = list(dom = 'tlp', pageLength = 8, lengthChange = FALSE, searching = FALSE)) %>% + formatRound(c('time', 'mu', 'R2', 'Dt'), digits = 2) + }, server = FALSE ) output$dataProcessingPlot <- renderPlot({ @@ -219,12 +299,24 @@ server <- function(input, output, session) { s1 = NULL s2 = input$dataProcessingTable_rows_selected gRates <- growthRates() - plot(x = gRates$time, y = gRates$Dt, xlim = rangesProcessing$x, ylim = rangesProcessing$y, xlab = "Experiment duration, h", ylab = "Doubling time, h") + # plot(x = gRates$time, y = gRates$Dt, xlim = rangesProcessing$x, ylim = rangesProcessing$y, xlab = "Experiment duration, h", ylab = "Doubling time, h") + twoord.plot(lx = gRates$time, + ly = gRates$Dt, + rx = gRates$time, + ry = gRates$mu, + xlim = rangesProcessing$x, + lylim = rangesProcessing$y, + # rylim = y2lim, + xlab = 'Experiment duration, h', + ylab = 'Doubling time, h', + rylab = 'Specific growth rate, 1/day', + rcol = 3, + rpch = 1) if (length(s1)) { points(gRates[s1, , drop = FALSE], pch = 19, cex = 1, col = 'green') } if (length(s2)) { - points(gRates[s2, , drop = FALSE], pch = 19, cex = 1.25) + points(gRates$time[s2], gRates$Dt[s2], pch = 19, cex = 1.25) } } }) @@ -235,12 +327,12 @@ server <- function(input, output, session) { # # http://shiny.rstudio.com # - +# UI Layout ==== ui <- fluidPage( tags$head(includeScript('google-analytics.js')), titlePanel("", windowTitle = "PBR Data Analysis"), sidebarLayout( - # Sidebar panel ==== + # UI - Sidebar panel ==== sidebarPanel( conditionalPanel( condition = 'input.conditionedSidePanels == 1', @@ -258,9 +350,8 @@ ui <- fluidPage( sliderInput( 'interval', "Averaging interval, min", - value = 1, min = 0.5, max = 10, step = 0.1 + value = 1, min = 0.0, max = 60, step = 0.1 ), - # numericInput('interval', 'Interval, min', 1, min = 0.5, max = 10, step = 0.1, width = '100px'), bsTooltip( 'interval', "Interval that is used for lumping and averaging untidy data. Provided in minutes.", @@ -271,9 +362,13 @@ ui <- fluidPage( fluidRow( selectInput('selectDataView', "Data to view", "OD680, AU") ), + fluidRow( + selectInput('selectDataView2', "Additional data to view", "-") + ), tags$hr(), fluidRow( - downloadButton('downloadData', "Download") + downloadButton('downloadData', "Download"), + textOutput('downloadSize') ) ), conditionalPanel( @@ -296,7 +391,7 @@ ui <- fluidPage( selectInput('selectGrowthRatesData', "Data for growth calculation", c("OD680, AU", "OD720, AU"), "OD680, AU") ), fluidRow( - selectInput('selectDilutionPump', "Pump used for dilutions", c("Turbidostat", "Pump 3", "Pump 4", "Pump 5", "Pump 6", "Pump 7"), "Pump 5") + selectInput('selectDilutionPump', "Pump used for dilutions", c("Pump 0", "Pump 3", "Pump 4", "Pump 5", "Pump 6", "Pump 7"), "Pump 0") ), tags$hr(), fluidRow( @@ -305,7 +400,7 @@ ui <- fluidPage( ), width = 3 ), - # Main panel ==== + # UI - Main panel ==== mainPanel( tabsetPanel( type = 'tabs', @@ -324,7 +419,7 @@ ui <- fluidPage( brush = brushOpts( id = 'dataViewPlot_brush', resetOnNew = TRUE - ) + ) ) ), tabPanel( @@ -339,11 +434,11 @@ ui <- fluidPage( column( 8, plotOutput('dataProcessingPlot', - dblclick = 'dataProcessingPlot_dblClick', - brush = brushOpts( - id = 'dataProcessingPlot_brush', - resetOnNew = TRUE - ) + dblclick = 'dataProcessingPlot_dblClick', + brush = brushOpts( + id = 'dataProcessingPlot_brush', + resetOnNew = TRUE + ) ) ) ) @@ -353,7 +448,7 @@ ui <- fluidPage( width = 9 ) ), - # Bottom panel ==== + # UI - Bottom panel ==== fluidRow( column( width = 3, @@ -402,5 +497,4 @@ ui <- fluidPage( ) ) ) - shinyApp(ui = ui, server = server) diff --git a/dbRegister.R b/dbRegister.R new file mode 100644 index 0000000..e69de29