In charlottesirot/isoHelpR: Help to handle TCD and CNEA files
#remove leading and trailing space
trim <- function (x) gsub("^\\s+|\\s+$", "", x)
# Returns the indices in the vector that correspond to integer or floating point
getNumericIndices <- function(vect) {
return(grep("^[+-]?([0-9]*[.])?[0-9]+$", vect, value = FALSE))
}
containsCharacter <- function(vect) {
numIndices <- getNumericIndices(vect)
result = c()
if(length(numIndices) == 0) {return(result)}
for(i in 1:length(vect)){
printDebug(trim(vect[i]))
if(!is.na(trim(vect[i]))){
if(!is.element(i, numIndices) && trim(vect[i]) != ""){
result <- c(result, i)
}
}
}
return(result)
}
DEBUG_FILE = "/home/cha/debug.log"
printDebug <- function(message){
write(paste("[", Sys.time(), "] ", message),file=DEBUG_FILE,append=TRUE)
write(message,file=DEBUG_FILE,append=TRUE)
}
complementVector <- function(VectR, x) {
length.VectR <- length(VectR)
length.x <- length(x)
y <- vector() #output
for(i in 1:length.VectR) {
if(is.na(match(VectR[i], x))) {
y <- c(y, i)
} else {}
}
return(VectR[y])
}
successiveValues <- function(vect) {
length.vect <- length(vect)
i <- 1
k <- 1
finalList <- list()
while(i < length.vect) {
finalList[k][[1]] <- vect[i]
while(vect[i + 1] == vect[i] +1 & i < length.vect) {
finalList[k][[1]] <- c(finalList[k][[1]], vect[i+1])
i <- i+1
}
i <- i+1
k <- k+1
}
return(finalList)
}
is.null.vector <- function(x) {
sapply(x, is.null)
}
is.numeric_cha <- function(x) {
sapply(1:length(x), function(i) {
if(is.null(x[i])) {return(F)}
toTest <- as.numeric(as.character(x[i]))
if(!is.na(toTest) & is.numeric(toTest)) {
return(T)
} else {F}
})
}
separateAnalysis_TCD <- function(data, column1) {
vect <- column1
length.vect <- length(vect)
begin <- NULL
end <- NULL
k <- 1
oneAnalyis <- list()
for (i in 0:(length.vect-1)) {
if(i != 0) {
if(is.na(vect[i]) & !is.na(vect[i+1])) {
end <- i
oneAnalyis[[k]] <- begin:end
begin <- i+1
k <- k+1
} else {}
} else {
begin <- 1
}
}
length.OneAnalysis <- length(oneAnalyis)
notNA <- which(is.na(vect))
if(length(unlist(oneAnalyis)) != length.vect) {
toTake <- length.vect - length(unlist(oneAnalyis))
oneAnalyis[[length.OneAnalysis + 1]] <- (length(vect) - toTake +1) : length(vect)
}
oneAnalyisToReturn <- lapply(1:length(oneAnalyis), function(x) {
data[oneAnalyis[[x]], ]
})
return(oneAnalyisToReturn)
}
#function for melting two vectors together
PlaceMelting = function(vect, vect2) {
vectFinal <- vector()
for(i in 1:length(vect)) {
for(j in 1: length(vect2)){
vectFinal <- c(vectFinal, paste0(vect[i], vect2[j]))
}
}
return(vectFinal)
}
boxplot.with.outlier.label <- function(y, label_name, ..., spread_text = T, data, plot = T, range = 1.5, label.col = "blue", push_text_right = 1.3, # enlarge push_text_right in order to push the text labels further from their point
segement_width_as_percent_of_label_dist = .45, # Change this if you want to have the line closer to the label (range should be between 0 to 1
jitter_if_duplicate = T, jitter_only_positive_duplicates = F)
{
# notes - this functions doesn't work if there are any missing values in the data.
# You must pre-process the data to make sure it is "complete".
# change log:
# 19.04.2011 - added support to "names" and "at" parameters.
# jitter_if_duplicate - will jitter (Actually just add a bit of numbers) so to be able to decide on which location to plot the label when having identical variables...
require(plyr) # for is.formula and ddply
# a function to jitter data in case of ties in Y's
jitter.duplicate <- function(x, only_positive = F)
{
if(only_positive) {
ss <- x > 0
} else {
ss <- T
}
ss_dup <- duplicated(x[ss])
# ss <- ss & ss_dup
temp_length <- length(x[ss][ss_dup])
x[ss][ss_dup] <- x[ss][ss_dup] + seq(from = 0.00001, to = 0.00002, length.out = temp_length)
x
}
# jitter.duplicate(c(1:5))
# jitter.duplicate(c(1:5,5,2))
# duplicated(jitter.duplicate(c(1:5,5,2)))
# jitter.duplicate(c(0,0,1:5,5,2))
# duplicated(jitter.duplicate(c(0,0,1:5,5,2)))
# handle cases where
if(jitter_if_duplicate) {
# warning("duplicate jutter of values in y is ON")
if(!missing(data)) { #e.g: we DO have data
# if(exists("y") && is.formula(y)) { # F && NULL # F & NULL
y_name <- as.character(substitute(y)) # I could have also used as.list(match.call())
# credit to Uwe Ligges and Marc Schwartz for the help
# https://mail.google.com/mail/?shva=1#inbox/12dd7ca2f9bfbc39
if(length(y_name) > 1) { # then it is a formula (for example: "~", "y", "x"
model_frame_y <- model.frame(y, data = data)
temp_y <- model_frame_y[,1]
temp_y <- jitter.duplicate(temp_y, jitter_only_positive_duplicates) # notice that the default of the function is to work only with positive values...
# the_txt <- paste(names(model_frame_y)[1], "temp_y", sep = "<<-") # wrong...
the_txt <- paste("data['",names(model_frame_y)[1],"'] <- temp_y", sep = "")
eval(parse(text = the_txt)) # jutter out y var so to be able to handle identical values.
} else { # this isn't a formula
data[,y_name] <- jitter.duplicate(data[,y_name], jitter_only_positive_duplicates)
y <- data[,y_name] # this will make it possible for boxplot(y, data) to work later (since it is not supposed to work with data when it's not a formula, but now it does :))
}
} else { # there is no "data"
if(is.formula(y)) { # if(exists("y") && is.formula(y)) { # F && NULL # F & NULL
temp_y <- model.frame(y)[,1]
temp_y <- jitter.duplicate(temp_y, jitter_only_positive_duplicates) # notice that the default of the function is to work only with positive values...
temp_y_name <- names(model.frame(y))[1] # we must extract the "names" before introducing a new enbironment (or there will be an error)
environment(y) <- new.env()
assign(temp_y_name, temp_y, environment(y))
# Credit and thanks for doing this goes to Niels Richard Hansen (2 Jan 30, 2011)
# http://r.789695.n4.nabble.com/environment-question-changing-variables-from-a-formula-through-model-frame-td3246608.html
# warning("Your original variable (in the global environemnt) was just jittered.") # maybe I should add a user input before doing this....
# the_txt <- paste(names(model_frame_y)[1], "temp_y", sep = "<<-")
# eval(parse(text = the_txt)) # jutter out y var so to be able to handle identical values.
} else {
y <- jitter.duplicate(y, jitter_only_positive_duplicates)
}
}
}
# the_txt <- paste("print(",names(model_frame_y)[1], ")")
# eval(parse(text = the_txt)) # jutter out y var so to be able to handle identical values.
# print(ls())
# y should be a formula of the type: y~x, y~a*b
# or it could be simply y
if(missing(data)) {
boxdata <- boxplot(y, plot = plot,range = range ,...)
} else {
boxdata <- boxplot(y, plot = plot,data = data, range = range ,...)
}
if(length(boxdata$names) == 1 && boxdata$names =="") boxdata$names <- 1 # this is for cases of type: boxplot(y) (when there is no dependent group)
if(length(boxdata$out) == 0 ) {
warning("No outliers detected for this boxplot")
return(invisible())
}
if(!missing(data)) attach(data) # this might lead to problams I should check out for alternatives for using attach here...
# creating a data.frame with information from the boxplot output about the outliers (location and group)
boxdata_group_name <- factor(boxdata$group)
levels(boxdata_group_name) <- boxdata$names[as.numeric(levels(boxdata_group_name))] # the subseting is for cases where we have some sub groups with no outliers
if(!is.null(list(...)$at)) { # if the user chose to use the "at" parameter, then we would like the function to still function (added on 19.04.2011)
boxdata$group <- list(...)$at[boxdata$group]
}
boxdata_outlier_df <- data.frame(group = boxdata_group_name, y = boxdata$out, x = boxdata$group)
# Let's extract the x,y variables from the formula:
if(is.formula(y))
{
model_frame_y <- model.frame(y)
# old solution: (which caused problems if we used the names parameter when using a 2 way formula... (since the order of the names is different then the levels order we get from using factor)
# y <- model_frame_y[,1]
# x <- model_frame_y[,-1]
y <- model_frame_y[,1]
x <- model_frame_y[,-1]
if(!is.null(dim(x))) { # then x is a matrix/data.frame of the type x1*x2*..and so on - and we should merge all the variations...
x <- apply(x,1, paste, collapse = ".")
}
} else {
# if(missing(x)) x <- rep(1, length(y))
x <- rep(1, length(y)) # we do this in case y comes as a vector and without x
}
# and put all the variables (x, y, and outlier label name) into one data.frame
DATA <- data.frame(label_name, x ,y)
if(!is.null(list(...)$names)) { # if the user chose to use the names parameter, then we would like the function to still function (added on 19.04.2011)
DATA$x <- factor(DATA$x, levels = unique(DATA$x))
levels(DATA$x) = list(...)$names # enable us to handle when the user adds the "names" parameter # fixed on 19.04.11 # notice that DATA$x must be of the "correct" order (that's why I used split above
# warning("Careful, the use of the 'names' parameter is experimental. If you notice any errors please e-mail me at: tal.galili@gmail.com")
}
if(!missing(data)) detach(data) # we don't need to have "data" attached anymore.
# let's only keep the rows with our outliers
boxplot.outlier.data <- function(xx, y_name = "y")
{
y <- xx[,y_name]
boxplot_range <- range(boxplot.stats(y, coef = range )$stats)
ss <- (y < boxplot_range[1]) | (y > boxplot_range[2])
return(xx[ss,])
}
outlier_df <-ddply(DATA, .(x), boxplot.outlier.data)
# create propor x/y locations to handle over-laping dots...
if(spread_text) {
# credit: Greg Snow
require(TeachingDemos)
temp_x <- boxdata_outlier_df[,"x"]
temp_y1 <- boxdata_outlier_df[,"y"]
temp_y2 <- temp_y1
for(i in unique(temp_x))
{
tmp <- temp_x == i
temp_y2[ tmp ] <- spread.labs( temp_y2[ tmp ], 1.3*strheight('A'), maxiter=6000, stepsize = 0.05) #, min=0 )
}
}
# max(strwidth(c("asa", "a"))
# move_text_right <- max(strwidth(outlier_df[,"label_name"]))
# plotting the outlier labels :) (I wish there was a non-loop wise way for doing this)
for(i in seq_len(dim(boxdata_outlier_df)[1]))
{
# ss <- (outlier_df[,"x"] %in% boxdata_outlier_df[i,]$group) & (outlier_df[,"y"] %in% boxdata_outlier_df[i,]$y)
# if(jitter_if_duplicate) {
# ss <- (outlier_df[,"x"] %in% boxdata_outlier_df[i,]$group) & closest.number(outlier_df[,"y"] boxdata_outlier_df[i,]$y)
# } else {
ss <- (outlier_df[,"x"] %in% boxdata_outlier_df[i,]$group) & (outlier_df[,"y"] %in% boxdata_outlier_df[i,]$y)
# }
current_label <- outlier_df[ss,"label_name"]
temp_x <- boxdata_outlier_df[i,"x"]
temp_y <- boxdata_outlier_df[i,"y"]
# cbind(boxdata_outlier_df, temp_y2)
# outlier_df
if(spread_text) {
temp_y_new <- temp_y2[i] # not ss
move_text_right <- strwidth(current_label) * push_text_right
text( temp_x+move_text_right, temp_y_new, current_label, col = label.col)
# strwidth
segments( temp_x+(move_text_right/6), temp_y, temp_x+(move_text_right*segement_width_as_percent_of_label_dist), temp_y_new )
} else {
text(temp_x, temp_y, current_label, pos = 4, col = label.col)
}
}
# outputing some of the information we collected
invisible(list(boxdata = boxdata, boxdata_outlier_df = boxdata_outlier_df, outlier_df=outlier_df))
}
To read beforhand
Aim of this document: This sheet has been created to help users to format the TCD file in order to upload it for further calculations.
WARNING: This file and its calculations do not correct automatically the TCD file (task dedicated to the user) but rather to point out the error of the raw TCD file. Before uploading the file in the next calculation (put the name of the function), please check with this document that there is NO error in all the following CONCLUSIONS (this task may require several run of utilisation of the function TCD_cleanR).
WARNING: The weight file and the TCD have to list the sample in the same order.
Cleaning and calculation settings
output$info <- renderUI({
div(column(6,
fileInput("TCD", label = p("Select the TCD file")),
textInput("nameSession", label = "", value = "Name of the session"),
textInput("dateProcessig", label = "", value = "Date of the analysis:"),
textInput("Responsible", label = "", value = "Responsible:"),
textInput("Temperature", label = "", value = "Lab Temperature:"),
textInput("SampleName", label = "", value = "Sample name:"),
textInput("system", label = "", value = "System:"),
textInput("Column", label = "", value = "Column:"),
textInput("temp.Owen", label = "", value = "Temp Owen:")
),
(column(6,
fileInput("weightData", label = p("Select the weight file")),
textInput("carrier.Gas", label = "", value = "Carrier gas:"),
textInput("carrier.flow", label = "", value = "Carrier flow:"),
textInput("Reference.gas1", label = "", value = "Reference gas 1:"),
textInput("Reference.flow1", label = "", value = "Reference flow1:"),
textInput("Reference.gas2", label = "", value = "Reference gas 2:"),
textInput("Reference.flow2", label = "", value = "Reference flow2:"),
textInput("Method", label = "", value = "Method:")
)
)
)
})
output$selectSample <- renderUI({
if(!is.null(input$TCD)) {
level.identifier.1 <- levels(as.factor(TCD()$Identifier.1))
div(column(12,
br(),
checkboxGroupInput("sample", label = p("Select the name(s) that correspond to samples"),
choices = level.identifier.1,
selected = level.identifier.1[1],
inline = T )
))
} else {}
})
r uiOutput("info")
r uiOutput("selectSample")
TCD <- reactive({
if(!is.null(input$TCD)) {
TCD <- read.xls (input$TCD$datapath, sheet = 1, header = TRUE, stringsAsFactors=FALSE)
TCD[,3] <- tolower(TCD[,3])
Rank.Analysis <- 2: (nrow(TCD)+ 1) # +1 to make the excel file correspond to the R file
TCD <- cbind(Rank.Analysis, TCD)
TCD <- as.data.frame(TCD)
TCD$rArea.Flash.TCD <- as.numeric(as.character(TCD$rArea.Flash.TCD))
return(TCD)
}
})
weightData <- reactive({
if(!is.null(input$weightData)) {
weightData <- read.xls (input$weightData$datapath, sheet = 1, header = TRUE, stringsAsFactors=FALSE)
weightData <- as.data.frame(weightData)
weightData$Measured.Weigth..mg. <- as.numeric(as.character(weightData$Measured.Weigth..mg.))
weightData$Box.pos <- as.character(weightData$Box.pos)
return(weightData)
}
})
output$Row_Error <- renderText({
if(!is.null(input$TCD)) {
emptyRow <- which(is.null(TCD()$Analysis) | is.na(TCD()$Analysis) | TCD()$Analysis == "" | TCD()$Analysis == " ")
if(length(emptyRow) != 0) {
toDisplay.1 <- paste("Some Analysis are missing value (DO NOT IGNORE!!). Please check the line(s):", paste((emptyRow +1), sep = " ", collapse = " "))
} else {NULL}
} else {}
})
output$Row_OK <- renderText({
if(!is.null(input$TCD)) {
emptyRow <- which(is.null(TCD()$Analysis) | is.na(TCD()$Analysis) | TCD()$Analysis == "" | TCD()$Analysis == " ")
if(length(emptyRow) == 0) {
toDisplay.1 <- "No problem in the Analysis column"
} else {}
} else {}
})
############################
## Condition 2: rArea Flash TCD with exactly three lines
############################
resultMatrix <- reactive({
if(!is.null(input$TCD)) {
sample <- input$sample
TCD.liste <- split(TCD(), TCD()$Analysis)
resultMatrix <- matrix(NA,ncol = 14) #the matrix summurizing the number of values in the rArea
for(i in 1:length(TCD.liste)) {
One.Analysis <- TCD.liste[[i]]
# is there some row that are empty?
Analysis_vide <- length(which(One.Analysis$Row == "" | is.na(One.Analysis$Row) | is.null(One.Analysis$Row)))
# is there some difference Row (1 = all the Identifier.1 are identicals, > 1 at least one line has a different Identifier.1)
Analysis_diff <- length(unique(One.Analysis$Row))
# is there some identifier.1 that are empty? (id1_vide = nb of cell empty)
id1_vide <- length(which(One.Analysis$Identifier.1 == "" | is.na(One.Analysis$Identifier.1) | is.null(One.Analysis$Identifier.1)))
# is there some difference identifier.1 (1 = all the Identifier.1 are identicals, > 1 at least one line has a different Identifier.1)
id1_diff <- length(unique(One.Analysis$Identifier.1))
# is there some difference identifier.2 (1 = all the Identifier.2 are identicals, > 1 at least one line has a different Identifier.2)
id2_diff <- length(unique(One.Analysis$Identifier.2))
# id2_vide for a sample = number of empty cells, for standard = number of not empty cells, if there is several id1 (so the identifity of the analysis is not very well known as a sample or a standard), id2_vide = 1
if(id1_vide != 0 | id1_diff > 1){
id2_vide <- 1
id2_diff <- 1
} else if(is.element(One.Analysis$Identifier.1[1], sample)){
# is there some identifier.2 that are empty? (id2_vide = nb of cell empty)
id2_vide <- length(which(One.Analysis$Identifier.2 == "" | is.na(One.Analysis$Identifier.2) | is.null(One.Analysis$Identifier.2)))
} else {
id2_vide <- length(which(One.Analysis$Identifier.2 != "" & !is.na(One.Analysis$Identifier.2) & !is.null(One.Analysis$Identifier.2)))
}
# nb of rArea value that are empty cells
nb.NA <- length(which(is.na(One.Analysis$rArea.Flash.TCD) | is.null(One.Analysis$rArea.Flash.TCD) | One.Analysis$rArea.Flash.TCD == ""))
# nb of rArea value that are not empty cells (if nbValue == 0 everything is ok, nbValue = 1 errror)
value <- length(which(!is.na(One.Analysis$rArea.Flash.TCD) & !is.null(One.Analysis$rArea.Flash.TCD) & One.Analysis$rArea.Flash.TCD != ""))
level.identifier.1 <- levels(as.factor(TCD()$Identifier.1))
if(One.Analysis$Identifier.1[1] == "sucrose") {
if(value == 1) {
nbValue <- 0
} else {
nbValue <- 1
}
} else {
if(value == 2) {
nbValue <- 0
} else {
nbValue <- 1
}
}
# nb value that are non numeric
notEmpty <- which(!is.na(One.Analysis$rArea.Flash.TCD) & !is.null(One.Analysis$rArea.Flash.TCD) & One.Analysis$rArea.Flash.TCD != "")
vect <- One.Analysis$rArea.Flash.TCD[notEmpty]
if(length(vect) == 0) {
nbCharacter <- 0
} else {
tempResult <- sapply(1:length(vect), function(x) {
toTest <- as.numeric(as.character(vect[x]))
return(is.na(toTest))
})
if(length(which(tempResult == T)) != 0) {
nbCharacter <- 1
} else {
nbCharacter <- 0
}
}
toAdd <- c(as.character(One.Analysis$Identifier.1[1]), as.character(One.Analysis$Identifier.2)[1], One.Analysis$Rank.Analysis[1], Analysis_vide, Analysis_diff, id1_vide, id1_diff, id2_vide, id2_diff, nbValue, nb.NA, nbCharacter, One.Analysis$rArea.Flash.TCD[1:2])
resultMatrix <- resultMatrix <- rbind(resultMatrix, toAdd)
}
resultMatrix <- resultMatrix[-1,]
colnames(resultMatrix) <- c("Identifier.1", "Identifier.2","FirstLine", "Analysis_vide", "Analysis_diff", "id1_vide", "id1_diff", "id2_vide", "id2_diff", "nbValue", "Nb.NA", "nbCharacter","rArea.Flash.TCD.N", "rArea.Flash.TCD.C")
rownames(resultMatrix) <- 1:nrow(resultMatrix)
resultMatrix <- as.data.frame(resultMatrix)
for(i in 3:ncol(resultMatrix)) {
resultMatrix[,i] <- as.numeric(as.character(resultMatrix[,i]))
}
resultMatrix <- resultMatrix[order(resultMatrix[,3]),]
return(resultMatrix)
} else {}
})
############################
## Condition 1Bis: nb analysis
############################
output$Analysis_Error <- renderText({
if(!is.null(input$TCD)) {
Analysis_vide <- which(resultMatrix()$Analysis_vide != 0)
if(length(Analysis_vide) != 0) {
toDisplay.1 <- paste("Some rows are empty. Please check the line(s):", paste(resultMatrix()$FirstLine[Analysis_vide], sep = " ", collapse = " "))
} else {NULL}
} else {}
})
output$Analysis_OK <- renderText({
if(!is.null(input$TCD)) {
Analysis_vide <- which(resultMatrix()$Analysis_vide != 0)
if(length(Analysis_vide) == 0) {
toDisplay.1 <- "No empty row name"
} else {}
} else {}
})
output$AnalysisDiff_Error <- renderText({
if(!is.null(input$TCD)) {
print(resultMatrix()$FirstLine[which(resultMatrix()$Analysis_diff != 1)])
Analysis_diff <- resultMatrix()$FirstLine[which(resultMatrix()$Analysis_diff != 1)]
if(length(Analysis_diff) != 0) {
toDisplay.1 <- paste("Some rows do not have the same name. Please check the analysis beginning line(s)", paste(Analysis_diff, sep = " ", collapse = " "))
} else {NULL}
} else {}
})
output$AnalysisDiff_OK <- renderText({
if(!is.null(input$TCD)) {
Analysis_diff <- resultMatrix()$FirstLine[which(resultMatrix()$Analysis_diff != 1)]
if(length(Analysis_diff) == 0) {
toDisplay.1 <-"Awesome! All the row names are similar in a single analysis."
} else {}
} else {}
})
############################
## Condition 1: identifier.1
############################
output$id1_Error <- renderText({
if(!is.null(input$TCD)) {
id1_vide <- which(resultMatrix()$id1_vide != 0)
if(length(id1_vide) != 0) {
toDisplay.1 <- paste("Some identifier.1 are empty. Please check the analysis beginning line(s):", paste(resultMatrix()$FirstLine[id1_vide], sep = " ", collapse = " "))
} else {NULL}
} else {}
})
output$id1_OK <- renderText({
if(!is.null(input$TCD)) {
id1_vide <- which(resultMatrix()$id1_vide != 0)
if(length(id1_vide) == 0) {
toDisplay.1 <- "No identifier.1 is empty"
} else {}
} else {}
})
output$id1Diff_Error <- renderText({
if(!is.null(input$TCD)) {
id1_diff <- resultMatrix()$FirstLine[which(resultMatrix()$id1_diff != 1)]
if(length(id1_diff) != 0) {
toDisplay.1 <- paste("Some identifier.1 do not have the same name. Please check the the analysis beginning line(s):", paste(id1_diff, sep = " ", collapse = " "))
} else {NULL}
} else {}
})
output$id1Diff_OK <- renderText({
if(!is.null(input$TCD)) {
id1_diff <- resultMatrix()$FirstLine[which(resultMatrix()$id1_diff != 1)]
if(length(id1_diff) == 0) {
toDisplay.1 <-"All the identifier.1 have the same name in a single analysis, That's great !"
} else {}
} else {}
})
############################
## Condition 2: identifier.2
############################
output$error_id.2_Error <- renderText({
if(!is.null(input$TCD)) {
error_id.2 <- resultMatrix()$FirstLine[which(resultMatrix()$id2_vide != 0)]
if(length(error_id.2) != 0) {
paste("Some analysis show empty identifier.2. Please check in the analysis beginning line(s)", paste(error_id.2, sep = " ", collapse = " "))
} else {}
} else {}
})
output$error_id.2_OK <- renderText({
if(!is.null(input$TCD)) {
error_id.2 <- resultMatrix()$FirstLine[which(resultMatrix()$id2_vide != 0)]
if(length(error_id.2) == 0) {
"Good, all the identifier.2 have a value!"
} else {}
} else {}
})
output$error.id2.sample_Error <- renderText({
if(!is.null(input$TCD)) {
error.id2.sample <- resultMatrix()$FirstLine[which(resultMatrix()$id2_diff != 1)]
if(length(error.id2.sample) != 0) {
paste("Some analysis show different name in their identifier.2. Please check in the analysis beginning line(s)", paste(error.id2.sample, sep = " ", collapse = " "))
} else {}
} else {}
})
output$error.id2.sample_OK <- renderText({
if(!is.null(input$TCD)) {
error.id2.sample <- resultMatrix()$FirstLine[which(resultMatrix()$id2_diff != 1)]
if(length(error.id2.sample) == 0) {
"No error in the names of the identifier.2, great :)"
} else {}
} else {}
})
############################
## Condition 3: r.Area
############################
output$error.nbValue_Error <- renderText({
if(!is.null(input$TCD)) {
error.nbValue <- resultMatrix()$FirstLine[which(resultMatrix()$nbValue != 0)]
if(length(error.nbValue) > 0) {
paste("There is a mistake in the number of values. Check the analysis beginning line(s):", paste(error.nbValue, sep = " ", collapse = " "))
} else {}
} else {}
})
output$error.nbValue_OK <- renderText({
if(!is.null(input$TCD)) {
error.nbValue <- resultMatrix()$FirstLine[which(resultMatrix()$nbValue != 0)]
if(length(error.nbValue) == 0) {
"There is a no mistake in the number of values"
} else {}
} else {}
})
output$error.nbNA_Error <- renderText({
if(!is.null(input$TCD)) {
error.nbNA <- resultMatrix()$FirstLine[which(resultMatrix()$Nb.NA != 1)]
if(length(error.nbNA) > 0) {
paste("There is a mistake in the number of NA value. Check the analysis beginning line(s):", paste(error.nbNA, sep = " ", collapse = " "))
} else {}
} else {}
})
output$error.nbNA_OK <- renderText({
if(!is.null(input$TCD)) {
error.nbNA <- resultMatrix()$FirstLine[which(resultMatrix()$Nb.NA != 1)]
if(length(error.nbNA) == 0) {
"There is a no mistake in the number of NA"
} else {}
} else {}
})
output$character_Error <- renderText({
if(!is.null(input$TCD)) {
TCD <- read.xls (input$TCD$datapath, sheet = 1, header = TRUE, stringsAsFactors=FALSE)
weightData <- read.xls (input$weightData$datapath, sheet = 1, header = TRUE, stringsAsFactors=FALSE)
errorChar_TCD <- containsCharacter(TCD$rArea.Flash.TCD)
errorChar_Weight <- containsCharacter(weightData$Measured.Weigth..mg.)
if(length(errorChar_TCD) > 0) {
paste("Oups, there is a character string in your TCD file. Check the line(s):", paste(TCD()$Rank.Analysis[errorChar_TCD], sep = " ", collapse = " "))
} else {
if(length(errorChar_Weight) > 0) {
paste("Oups, there is a character string in your Weight file. Check the line(s):", paste(errorChar_Weight, sep = " ", collapse = " "))
} else {}
}
} else {}
})
output$character_OK <- renderText({
if(!is.null(input$TCD)) {
TCD <- read.xls (input$TCD$datapath, sheet = 1, header = TRUE, stringsAsFactors=FALSE)
weightData <- read.xls (input$weightData$datapath, sheet = 1, header = TRUE, stringsAsFactors=FALSE)
errorChar_TCD <- containsCharacter(TCD$rArea.Flash.TCD)
errorChar_Weight <- containsCharacter(weightData$Measured.Weigth..mg.)
if(length(errorChar_TCD) == 0 & length(errorChar_Weight) == 0) {
"Perfect!! There is no character in your files"
} else {}
} else {}
})
############################
## Condition 3: For sample, all identifier.2 of a single analysis should be not empty and identical
############################
dataTables <- reactive({
if(!is.null(input$TCD)) {
sample <- input$sample
place <- NULL
for(x in 1:length(sample)) {
if(x == 1) {
TCD.sample <- resultMatrix()[which(resultMatrix()$Identifier.1 == sample[x]), ]
place <- which(resultMatrix()$Identifier.1 == sample[x])
} else {
TCD.sample <- rbind(TCD.sample, resultMatrix()[which(resultMatrix()$Identifier.1 == sample[x]), ])
place <- c(place, which(resultMatrix()$Identifier.1 == sample[x]))
}
}
place <- sort(place)
PlaceBar <- complementVector(1:nrow(resultMatrix()), place)
TCD.sample <- TCD.sample[order(TCD.sample$FirstLine),] # data with only the sample
TCD.standard <- resultMatrix()[PlaceBar, ] # data with only the standards
return(list(TCD.sample, TCD.standard))
} else {}
})
dataStandard <- reactive({
if(!is.null(input$TCD)) {
dataTables()[[2]]
} else {}
})
dataSample <- reactive({
if(!is.null(input$TCD)) {
dataTables()[[1]]
} else {}
})
output$dataSampleToPrint <- renderDT({
if(!is.null(input$TCD)) {
dataSample()[,c(1,2, (ncol(dataSample()) -1), ncol(dataSample()))]
} else {}
})
output$dataStandardToPrint <- renderDT({
if(!is.null(input$TCD)) {
dataStandard()[,c(1,2, (ncol(dataSample()) -1), ncol(dataSample()))]
} else {}
})
############################
## Condition 4: identifier.2 for weight and TCD file shoule be in the same order
############################
Data_plus_weight <- reactive({ ## for pasting the weight of the sample
if(!is.null(input$TCD) & !is.null(input$weightData)) {
errorToCount <- 0 # flag for error
line.flag <- NA
Data_plus_weight <- NULL
nRow.dataSample <- nrow(dataSample())
nRow.weightData <- nrow(weightData())
if(nRow.dataSample != nRow.weightData) {
errorToCount <- 1
} else {
for(i in 1:nRow.dataSample){
if(as.character(dataSample()$Identifier.2[i]) != as.character(weightData()$Box.pos[i])){
errorToCount <- 1
line.flag <- dataSample()$FirstLine[i]
} else {}
}
if(errorToCount == 0) {
Data_plus_weight <- cbind(dataSample(), weightData()$Name, weightData()$Measured.Weigth..mg.)
Data_plus_weight <- as.data.frame(Data_plus_weight)
colnames(Data_plus_weight) <- c(colnames(dataSample()), "sampleName", "SampleWeight")
} else {}
}
return(list(c(errorToCount, line.flag), Data_plus_weight))
} else {}
})
output$toChec2k <- renderTable({
dataSample()$Rank.Analysis
})
output$weight_Error <- renderText({
if(!is.null(input$TCD) & !is.null(input$weightData)) {
if(Data_plus_weight()[[1]][1] != 0){
if(!is.na(Data_plus_weight()[[1]][2])){
paste("Weight and TCD files do not match on their identifier.2 (DON'T IGNORE THIS ERROR), check line(s):",
paste(Data_plus_weight()[[1]][2], sep = " ", collapse = " "))
} else {
paste("Weight and TCD files do not have the same number of rows (DON'T IGNORE THIS ERROR)")
}
} else {
NULL
}
} else {}
})
output$weight_OK <- renderText({
if(!is.null(input$TCD) & !is.null(input$weightData)) {
if(Data_plus_weight()[[1]][1] != 0){
NULL
} else {
"The weight file seems correct (Note that it did not check for the box name)"
}
} else {}
})
Conditions tested for cleaning
- Condition 1: Check that there are no missing Analysis number (definition of a single analysis)
r textOutput("Row_OK")
r textOutput("Row_Error")
- Condition 2: Check that all analysis has only one single row name and that none of these cells are empty
r textOutput("Analysis_OK")
r textOutput("Analysis_Error")
r textOutput("AnalysisDiff_OK")
r textOutput("AnalysisDiff_Error")
- Condition 3: Check that all analysis has only one single Identifier 1 and that none of these cells are empty
r textOutput("id1_OK")
r textOutput("id1_Error")
r textOutput("id1Diff_OK")
r textOutput("id1Diff_Error")
- Condition 4: Check that all analysis has only one single Identifier 2 and that none of these cells are empty
r textOutput("error_id.2_Error")
r textOutput("error_id.2_OK")
r textOutput("error.id2.sample_Error")
r textOutput("error.id2.sample_OK")
- Condition 5: Check that rArea Flash TCD has exactly three lines (except for the sucrose that has only two lines) cand contains exactly two values (respectively one) and an empty cell
r textOutput("error.nbValue_OK")
r textOutput("error.nbValue_Error")
r textOutput("error.nbNA_OK")
r textOutput("error.nbNA_Error")
- Condition 6: Check that the order of the samples are the same between the TCD and weight files
r textOutput("weight_Error")
r textOutput("weight_OK")
- Condition 7: Check that weight of the samples and rArea values do not contain any character
r textOutput("character_OK")
r textOutput("character_Error")
Data Samples:
r DTOutput("dataSampleToPrint")
Data Standards:
r DTOutput("dataStandardToPrint")
Graphical detection of mistakes - Outlier highlighting
output$forBoxPlot <- renderUI({
if(!is.null(input$TCD)) {
level.identifier.1 <- levels(as.factor(TCD()$Identifier.1))
checkboxGroupInput("toDisplay", label = "",
choices = level.identifier.1,
selected = level.identifier.1,
inline = T )
} else {}
})
output$boxplot <- renderPlot({
if(!is.null(input$TCD)) {
toDisplay <- input$toDisplay
for(x in 1:length(toDisplay)) {
if(x == 1) {
dataTemp <- resultMatrix()[which(resultMatrix()$Identifier.1 == toDisplay[x]), ]
} else {
dataTemp <- rbind(dataTemp, resultMatrix()[which(resultMatrix()$Identifier.1 == toDisplay[x]), ])
}
}
par(mfrow = c(1,2), mar = c(2,3,1.2,1.2))
ylim.C <- c(min(dataTemp$rArea.Flash.TCD.C, na.rm = T) - abs(min(dataTemp$rArea.Flash.TCD.C, na.rm = T))*0.1, max(dataTemp$rArea.Flash.TCD.C, na.rm = T) + abs(max(dataTemp$rArea.Flash.TCD.C, na.rm = T))*0.1)
boxplot.with.outlier.label(as.numeric(as.character(dataTemp$rArea.Flash.TCD.C)), label_name = dataTemp$Identifier.2, ylim = ylim.C, cex = 1.25)
mtext("rArea.Flash.TCD.C", side = 1)
ylim.N <- c(min(dataTemp$rArea.Flash.TCD.N, na.rm = T) - abs(min(dataTemp$rArea.Flash.TCD.N, na.rm = T))*0.1, max(dataTemp$rArea.Flash.TCD.N, na.rm = T) + abs(max(dataTemp$rArea.Flash.TCD.N, na.rm = T))*0.1)
boxplot.with.outlier.label(as.numeric(as.character(dataTemp$rArea.Flash.TCD.N)), label_name = dataTemp$Identifier.2, ylim = ylim.N, cex = 1.25)
mtext("rArea.Flash.TCD.N", side = 1)
} else {}
})
r uiOutput('forBoxPlot')
r plotOutput('boxplot')
Conclusions of the cleaning
finalConclusion <- reactive({
if(!is.null(resultMatrix())) {
id1_vide <- which(resultMatrix()$id1_vide != 0)
id1_diff <- resultMatrix()$FirstLine[which(resultMatrix()$id1_diff != 1)]
error_id.2 <- resultMatrix()$FirstLine[which(resultMatrix()$id2_vide != 0)]
error.id2.sample <- resultMatrix()$FirstLine[which(resultMatrix()$id2_diff != 1)]
error.nbValue <- resultMatrix()$FirstLine[which(resultMatrix()$nbValue != 0)]
error.nbNA <- resultMatrix()$FirstLine[which(resultMatrix()$Nb.NA != 1)]
errorChar <- resultMatrix()$FirstLine[which(resultMatrix()$nbCharacter != 0)]
Analysis_vide <- which(resultMatrix()$Analysis_vide != 0)
Analysis_diff <- resultMatrix()$FirstLine[which(resultMatrix()$Analysis_diff != 1)]
if(!is.null(Data_plus_weight())) {
if(length(Analysis_vide) != 0 | length(Analysis_diff) != 0 | length(id1_vide) != 0 | length(id1_diff) != 0 | length(error_id.2) != 0 | length(error.id2.sample) != 0 | Data_plus_weight()[[1]][1] != 0 | length(error.nbNA) != 0 | length(errorChar) != 0 |length(error.nbValue) != 0 ) {
return(TRUE)
} else {return(FALSE)}
} else {return(TRUE)}
} else {return(TRUE)}
})
output$finalConclusion_error <- renderText({
if(!is.null(resultMatrix())) {
if(finalConclusion() == TRUE) {
"There is at least one mistake in your files. <br> Please correct according to previously before continuing to read this file."
} else {NULL}
} else {NULL}
})
output$finalConclusion_OK <- renderText({
if(!is.null(resultMatrix())) {
if(finalConclusion() == FALSE) {
"It seems that your files are correct."
} else {NULL}
} else {NULL}
})
r textOutput("finalConclusion_OK")
r span(htmlOutput("finalConclusion_error"), style="color:red")
Settings for "Quant.file" creation
WARNING: Before continuing in this file, please check the conditions above do NOT contain any error in required CONCLUSIONS (this task may require several run of utilisation of the function TCD_cleanR). If the TCD file is upload without this last verification, Quant.CreatR CANNOT garantee the validity of the following data.
r uiOutput("info.2")
output$info.2 <- renderUI({
backgroundValues <- c(0, 1167)
content.GelA <- c(0.16, 0.42)
gelA <- levels(as.factor(Data_plus_weight_table()$sampleName))[(str_detect(levels(as.factor(Data_plus_weight_table()$sampleName)), "el")| str_detect(levels(as.factor(Data_plus_weight_table()$sampleName)), "EL"))]
if(length(gelA) == 0) {
gelA <- levels(as.factor(Data_plus_weight_table()$sampleName))[1]
}
div(column(6,
textInput("N.background", label = "N background value for Area.Flash.TCD.N", value = backgroundValues[1]),
textInput("N.gelA", label = "GelA N content", value = content.GelA[1])
),
(column(6,
textInput("C.background", label = "C background value for Area.Flash.TCD.C", value = backgroundValues[2]),
textInput("C.gelA", label = "GelA C content", value = content.GelA[2])
)
),
column(12,
checkboxGroupInput("gelA.Name.input", label = p("Choose the name that correspond to GelA"),
choices = levels(as.factor(Data_plus_weight_table()$sampleName)),
selected = gelA,
inline =T)
)
)
})
backgroundValues <- reactive({
return(c(as.numeric(as.character(input$N.background)), as.numeric(as.character(input$C.background))))
})
Data_plus_weight_table <- reactive({
if(!is.null(Data_plus_weight())) {
tempTable <- data.frame(Data_plus_weight()[[2]]$Identifier.1, Data_plus_weight()[[2]]$Identifier.2, Data_plus_weight()[[2]]$sampleName, Data_plus_weight()[[2]]$SampleWeight, Data_plus_weight()[[2]]$rArea.Flash.TCD.N, Data_plus_weight()[[2]]$rArea.Flash.TCD.C)
Rank.Analysis <- 1:nrow(tempTable)
tempTable <- cbind(Rank.Analysis, tempTable)
colnames(tempTable) <- c("Rank.Analysis","Identifier.1", "Identifier.2", "sampleName", "SampleWeight", "rArea.Flash.TCD.N", "rArea.Flash.TCD.C")
return(tempTable)
} else {}
})
content.GelA <- reactive({
return(c(as.numeric(as.character(input$N.gelA)), as.numeric(as.character(input$C.gelA))))
})
Data_plus_weight_corrected <- reactive({
if(!is.null(Data_plus_weight_table())) {
corrected.N <- Data_plus_weight_table()$rArea.Flash.TCD.N - backgroundValues()[1]
corrected.C <- Data_plus_weight_table()$rArea.Flash.TCD.C - backgroundValues()[2]
temp <- data.frame(Data_plus_weight_table(), corrected.N, corrected.C)
colnames(temp)[8:9] <- c("Corrected.Area.N", "Corrected.Area.C")
return(temp)
} else {}
})
GelA.table <- reactive({
if(!is.null(Data_plus_weight_table())) {
for(x in 1:length(input$gelA.Name.input)) {
if(x == 1) {
gelA <- Data_plus_weight_corrected()[which(Data_plus_weight_corrected()$sampleName == input$gelA.Name.input[x]), ]
} else {
gelA <- rbind(gelA, Data_plus_weight_corrected()[which(Data_plus_weight_corrected()$sampleName == input$gelA.Name.input[x]), ])
}
}
temp <- matrix()
for(x in 1: (nrow(gelA) + 1)) {
if(x == 1) {
temp <- c(0, "Blank", as.character("Blank"), as.character("Blank"), 0, as.numeric(as.character(backgroundValues())), as.numeric(as.character(backgroundValues())))
} else {
temp <- rbind(temp, gelA[x-1, ])
}
}
temp[,5] <- as.numeric(as.character(temp[,5]))
temp[1,5] <- 0
mg.N.perCup <- as.numeric(as.character(temp$SampleWeight)) * content.GelA()[1] * 1000
mg.C.perCup <- as.numeric(as.character(temp$SampleWeight)) * content.GelA()[2] * 1000
temp <- cbind(temp, mg.N.perCup, mg.C.perCup)
temp$Rank.Analysis <- as.numeric(as.character(temp$Rank.Analysis))
temp <- temp[order(temp$Rank.Analysis), ]
colnames(temp) <- c(colnames(Data_plus_weight_corrected()), "mg.N.perCup", "mg.C.perCup")
temp2 <- c("Blank", as.character(temp[,3]))
temp[,3] <- temp2[-2]
temp3 <- c("Blank", as.character(temp[,4]))
temp[,4] <- temp3[-2]
return(temp)
} else {}
})
GelA linear regression
1. Nitrogen
output$GelA.tokeep.N <- renderUI({
if(!is.null(Data_plus_weight_table())) {
checkboxGroupInput("GelA.tokeep.N", label = p("Select the gelA to keep for the linear regression"),
choices = GelA.table()$Identifier.2,
selected = GelA.table()$Identifier.2,
inline = T )
} else {}
})
tableGelA.tokeep.N <- reactive({
if(!is.null(Data_plus_weight_table())) {
for(x in 1:length(input$GelA.tokeep.N)) {
if(x == 1) {
tableGelA.tokeep.N <- GelA.table()[which(GelA.table()$Identifier.2 == input$GelA.tokeep.N[x]), ]
} else {
tableGelA.tokeep.N <- rbind(tableGelA.tokeep.N, GelA.table()[which(GelA.table()$Identifier.2 == input$GelA.tokeep.N[x]), ])
}
}
return(tableGelA.tokeep.N)
} else {}
})
model.N <- reactive({
model.N.NR <- lm(as.numeric(as.character(tableGelA.tokeep.N()$rArea.Flash.TCD.N)) ~ as.numeric(as.character(tableGelA.tokeep.N()$mg.N.perCup)) + 0)
Slope.N <- model.N.NR$coefficients
return(Slope.N)
})
output$linearRegression.N <- renderPlot({
plot(as.numeric(as.character(tableGelA.tokeep.N()$rArea.Flash.TCD.N)) ~ as.numeric(as.character(tableGelA.tokeep.N()$mg.N.perCup)), ylab = "rArea.Flash.TCD.N", xlab = "mg.N.perCup")
text(as.numeric(as.character(tableGelA.tokeep.N()$mg.N.perCup)), as.numeric(as.character(tableGelA.tokeep.N()$rArea.Flash.TCD.N)), labels=as.character(tableGelA.tokeep.N()$Identifier.2), cex= 0.7, pos=4)
abline(a = 0, b = model.N(), col = 'red')
})
output$modelN <- renderText({
paste("For N, the slope of the model:", round(model.N(),2))
})
r uiOutput("GelA.tokeep.N")
r plotOutput('linearRegression.N')
r textOutput('modelN')
2. Carbon
output$GelA.tokeep.C <- renderUI({
if(!is.null(Data_plus_weight_table())) {
checkboxGroupInput("GelA.tokeep.C", label = p("Select the gelA to keep for the linear regression"),
choices = GelA.table()$Identifier.2,
selected = GelA.table()$Identifier.2,
inline = T )
} else {}
})
tableGelA.tokeep.C <- reactive({
if(!is.null(Data_plus_weight_table())) {
for(x in 1:length(input$GelA.tokeep.C)) {
if(x == 1) {
tableGelA.tokeep.C <- GelA.table()[which(GelA.table()$Identifier.2 == input$GelA.tokeep.C[x]), ]
} else {
tableGelA.tokeep.C <- rbind(tableGelA.tokeep.C, GelA.table()[which(GelA.table()$Identifier.2 == input$GelA.tokeep.C[x]), ])
}
}
return(tableGelA.tokeep.C)
} else {}
})
output$toCheck <- renderTable({
# tableGelA.tokeep.C()
})
model.C <- reactive({
model.C.NR <- lm(as.numeric(as.character(tableGelA.tokeep.C()$rArea.Flash.TCD.C)) ~ as.numeric(as.character(tableGelA.tokeep.C()$mg.C.perCup)) + 0)
Slope.C <- model.C.NR$coefficients
return(Slope.C)
})
output$linearRegression.C <- renderPlot({
plot(as.numeric(as.character(tableGelA.tokeep.C()$rArea.Flash.TCD.C)) ~ as.numeric(as.character(tableGelA.tokeep.C()$mg.C.perCup)), ylab = "rArea.Flash.TCD.C", xlab = "mg.C.perCup")
text(as.numeric(as.character(tableGelA.tokeep.C()$mg.C.perCup)), as.numeric(as.character(tableGelA.tokeep.C()$rArea.Flash.TCD.C)), labels=as.character(tableGelA.tokeep.C()$Identifier.2), cex= 0.7, pos=4)
abline(a = 0, b = model.C(),col = 'red')
})
output$modelC <- renderText({
paste("For C, the slope of the model: ", round(model.C(),2))
})
r uiOutput("GelA.tokeep.C")
r tableOutput("toCheck")
r plotOutput('linearRegression.C')
r textOutput('modelC')
Creation of the final "Quant" file
finalTable.Sample <- reactive({
if(!is.null(Data_plus_weight_table())) {
Weight.N.perCup <- Data_plus_weight_corrected()$Corrected.Area.N/model.N()
Weight.C.perCup <- Data_plus_weight_corrected()$Corrected.Area.C/model.C()
Weight.N.kg <- Weight.N.perCup/Data_plus_weight_corrected()$SampleWeight*1000
Weight.C.kg <- Weight.C.perCup/Data_plus_weight_corrected()$SampleWeight*1000
C.N.Ratio <- (Weight.C.kg/12)/(Weight.N.kg/14)
temporary.TCDtable <- cbind(Data_plus_weight_corrected(),Weight.N.perCup, Weight.C.perCup, Weight.N.kg, Weight.C.kg, C.N.Ratio)
for(i in 5:12) {
temporary.TCDtable[,i] <- as.numeric(as.character(temporary.TCDtable[,i]))
}
return(temporary.TCDtable)
} else {}
})
output$tableSample.ToDisplay <- renderDT({
if(!is.null(Data_plus_weight_table())) {
return(finalTable.Sample())
} else {}
})
output$nameFile <- renderText({
if(!is.null(Data_plus_weight_table())) {
if(input$nameSession == "Name of the session") {
toAdd <- ""
} else {
toAdd <- input$nameSession
}
paste("This table has already been saved in an excel sheet called: ", paste0("finalTable.Sample_",toAdd, ".csv" ))
} else {}
})
output$SaveButton <- renderUI({
actionButton("save", "Save the data")
})
output$Save <- renderUI({
if(!is.null(input$save)) {
if(input$save > 0){
isolate({
if(input$nameSession == "Name of the session") {
toAdd <- ""
} else {
toAdd <- paste0("_", input$nameSession)
}
table0 <- matrix("", 24, 2)
table0[,1] <- c("Total C and D Quantification Analysis",
"",
"1. Session settings",
"Date",
"Samples",
"Responsible",
"Lab. Temp",
"System",
"Column",
"Temp, Owen",
"Carrier gas",
"Carrier flow",
"Reference gas1",
"Reference flow",
"Reference gas2",
"Reference flow",
"Method",
"Content of N in Gel A house standard",
"Content of C in Gel A house standard",
"N background value for Area.Flash.TCD.N",
"C background value for Area.Flash.TCD.C",
"", "",
"2. GelA table"
)
table0[,2] <- c("",
"",
"",
input$dateProcessig,
input$SampleName,
input$Responsible,
input$Temperature,
input$system,
input$Column,
input$temp.Owen,
input$carrier.Gas,
input$carrier.flow,
input$Reference.gas1,
input$Reference.flow1,
input$Reference.gas2,
input$Reference.flow2,
input$Method,
input$N.gelA,
input$C.gelA,
input$N.background,
input$C.background,
"", "",
""
)
normStyle <- createStyle(valign = "center", halign = "center", numFmt = "0.00")
GeneraltitleStyle <- createStyle(valign = "center", halign = "center", fontSize = 14, textDecoration = "bold")
titleStyle <- createStyle(valign = "center", halign = "left", fontSize = 14, textDecoration = "bold")
tableStyle <- createStyle(borderStyle = "thin", border = "TopBottomLeftRight")
colorPurple <- createStyle(fgFill = "#800080")
colorGreen <- createStyle(fgFill = "#99cc00")
table.Interm1 <- matrix("3. General Table", ncol = 1, nrow = 1)
wb <- createWorkbook("Example.xlsx")
addWorksheet(wb, "TCD_data")
writeData(wb, sheet = 1, TCD(), colNames = T)
addWorksheet(wb, "quantification_data")
writeData(wb, sheet = 2, table0, colNames = FALSE)
writeData(wb, sheet = 2, GelA.table(), startRow = nrow(table0) + 1, colNames = T)
writeData(wb, sheet = 2, table.Interm1, startRow = nrow(table0) + 4 + nrow(GelA.table()), colNames = F)
writeData(wb, sheet = 2, finalTable.Sample(), startRow = nrow(table0) + 5 + nrow(GelA.table()), colNames = T)
nbRow_FinalTable <- nrow(table0) + 5 + nrow(GelA.table()) + nrow(finalTable.Sample())
lapply(1:14, function(x) {
addStyle(wb, sheet = 2, normStyle, cols = x, rows = 1:nbRow_FinalTable)
})
lapply(1:11, function(x) {
addStyle(wb, sheet = 2, tableStyle, cols = x, rows = 25:(25+nrow(GelA.table())), stack = T)
})
finalTable_begin <- nrow(table0) + 5 + nrow(GelA.table())
finalTable_end <- nrow(table0) + 5 + nrow(GelA.table()) + nrow(finalTable.Sample())
lapply(1:14, function(x) {
addStyle(wb, sheet = 2, tableStyle, cols = x, rows = finalTable_begin:finalTable_end, stack = T)
})
addStyle(wb, sheet = 2, GeneraltitleStyle, rows = 1, cols = 1, stack = T)
addStyle(wb, sheet = 2, titleStyle, rows = 3, cols = 1, stack = T)
addStyle(wb, sheet = 2, titleStyle, rows = nrow(table0), cols = 1, stack = T)
addStyle(wb, sheet = 2, titleStyle, rows = nrow(table0) + 4 + nrow(GelA.table()), cols = 1, stack = T)
addStyle(wb, sheet = 2, colorPurple, cols = 12, rows = finalTable_begin:finalTable_end, stack = T)
addStyle(wb, sheet = 2, colorPurple, cols = 13, rows = finalTable_begin:finalTable_end, stack = T)
addStyle(wb, sheet = 2, colorGreen, cols = 14, rows = finalTable_begin:finalTable_end, stack = T)
mergeCells(wb, sheet = 2, cols = 1:18, rows = 1)
mergeCells(wb, sheet = 2, cols = 1:8, rows = 3)
mergeCells(wb, sheet = 2, cols = 1:8, rows = nrow(table0))
mergeCells(wb, sheet = 2, cols = 1:8, rows = nrow(table0) + 4 + nrow(GelA.table()))
if(Sys.info()[1] == "Windows"){
path <- choose.dir()
} else {
path <- jchoose.dir()
}
pathExport <- paste0(path, "/QuantFile",toAdd, ".xlsx")
saveWorkbook(wb, file = pathExport, overwrite = TRUE)
})
return("Your results have been saved :)")
} else {}
} else {}
})
Final Sample table
r DTOutput('tableSample.ToDisplay')
r uiOutput("SaveButton")
r uiOutput("Save")
Data exploration
output$pivot <- renderRpivotTable({
rpivotTable(finalTable.Sample(),width="100%", height="400px")
})
r rpivotTableOutput('pivot')
charlottesirot/isoHelpR documentation built on May 29, 2019, 12:05 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
#remove leading and trailing space trim <- function (x) gsub("^\\s+|\\s+$", "", x) # Returns the indices in the vector that correspond to integer or floating point getNumericIndices <- function(vect) { return(grep("^[+-]?([0-9]*[.])?[0-9]+$", vect, value = FALSE)) } containsCharacter <- function(vect) { numIndices <- getNumericIndices(vect) result = c() if(length(numIndices) == 0) {return(result)} for(i in 1:length(vect)){ printDebug(trim(vect[i])) if(!is.na(trim(vect[i]))){ if(!is.element(i, numIndices) && trim(vect[i]) != ""){ result <- c(result, i) } } } return(result) } DEBUG_FILE = "/home/cha/debug.log" printDebug <- function(message){ write(paste("[", Sys.time(), "] ", message),file=DEBUG_FILE,append=TRUE) write(message,file=DEBUG_FILE,append=TRUE) } complementVector <- function(VectR, x) { length.VectR <- length(VectR) length.x <- length(x) y <- vector() #output for(i in 1:length.VectR) { if(is.na(match(VectR[i], x))) { y <- c(y, i) } else {} } return(VectR[y]) } successiveValues <- function(vect) { length.vect <- length(vect) i <- 1 k <- 1 finalList <- list() while(i < length.vect) { finalList[k][[1]] <- vect[i] while(vect[i + 1] == vect[i] +1 & i < length.vect) { finalList[k][[1]] <- c(finalList[k][[1]], vect[i+1]) i <- i+1 } i <- i+1 k <- k+1 } return(finalList) } is.null.vector <- function(x) { sapply(x, is.null) } is.numeric_cha <- function(x) { sapply(1:length(x), function(i) { if(is.null(x[i])) {return(F)} toTest <- as.numeric(as.character(x[i])) if(!is.na(toTest) & is.numeric(toTest)) { return(T) } else {F} }) } separateAnalysis_TCD <- function(data, column1) { vect <- column1 length.vect <- length(vect) begin <- NULL end <- NULL k <- 1 oneAnalyis <- list() for (i in 0:(length.vect-1)) { if(i != 0) { if(is.na(vect[i]) & !is.na(vect[i+1])) { end <- i oneAnalyis[[k]] <- begin:end begin <- i+1 k <- k+1 } else {} } else { begin <- 1 } } length.OneAnalysis <- length(oneAnalyis) notNA <- which(is.na(vect)) if(length(unlist(oneAnalyis)) != length.vect) { toTake <- length.vect - length(unlist(oneAnalyis)) oneAnalyis[[length.OneAnalysis + 1]] <- (length(vect) - toTake +1) : length(vect) } oneAnalyisToReturn <- lapply(1:length(oneAnalyis), function(x) { data[oneAnalyis[[x]], ] }) return(oneAnalyisToReturn) } #function for melting two vectors together PlaceMelting = function(vect, vect2) { vectFinal <- vector() for(i in 1:length(vect)) { for(j in 1: length(vect2)){ vectFinal <- c(vectFinal, paste0(vect[i], vect2[j])) } } return(vectFinal) } boxplot.with.outlier.label <- function(y, label_name, ..., spread_text = T, data, plot = T, range = 1.5, label.col = "blue", push_text_right = 1.3, # enlarge push_text_right in order to push the text labels further from their point segement_width_as_percent_of_label_dist = .45, # Change this if you want to have the line closer to the label (range should be between 0 to 1 jitter_if_duplicate = T, jitter_only_positive_duplicates = F) { # notes - this functions doesn't work if there are any missing values in the data. # You must pre-process the data to make sure it is "complete". # change log: # 19.04.2011 - added support to "names" and "at" parameters. # jitter_if_duplicate - will jitter (Actually just add a bit of numbers) so to be able to decide on which location to plot the label when having identical variables... require(plyr) # for is.formula and ddply # a function to jitter data in case of ties in Y's jitter.duplicate <- function(x, only_positive = F) { if(only_positive) { ss <- x > 0 } else { ss <- T } ss_dup <- duplicated(x[ss]) # ss <- ss & ss_dup temp_length <- length(x[ss][ss_dup]) x[ss][ss_dup] <- x[ss][ss_dup] + seq(from = 0.00001, to = 0.00002, length.out = temp_length) x } # jitter.duplicate(c(1:5)) # jitter.duplicate(c(1:5,5,2)) # duplicated(jitter.duplicate(c(1:5,5,2))) # jitter.duplicate(c(0,0,1:5,5,2)) # duplicated(jitter.duplicate(c(0,0,1:5,5,2))) # handle cases where if(jitter_if_duplicate) { # warning("duplicate jutter of values in y is ON") if(!missing(data)) { #e.g: we DO have data # if(exists("y") && is.formula(y)) { # F && NULL # F & NULL y_name <- as.character(substitute(y)) # I could have also used as.list(match.call()) # credit to Uwe Ligges and Marc Schwartz for the help # https://mail.google.com/mail/?shva=1#inbox/12dd7ca2f9bfbc39 if(length(y_name) > 1) { # then it is a formula (for example: "~", "y", "x" model_frame_y <- model.frame(y, data = data) temp_y <- model_frame_y[,1] temp_y <- jitter.duplicate(temp_y, jitter_only_positive_duplicates) # notice that the default of the function is to work only with positive values... # the_txt <- paste(names(model_frame_y)[1], "temp_y", sep = "<<-") # wrong... the_txt <- paste("data['",names(model_frame_y)[1],"'] <- temp_y", sep = "") eval(parse(text = the_txt)) # jutter out y var so to be able to handle identical values. } else { # this isn't a formula data[,y_name] <- jitter.duplicate(data[,y_name], jitter_only_positive_duplicates) y <- data[,y_name] # this will make it possible for boxplot(y, data) to work later (since it is not supposed to work with data when it's not a formula, but now it does :)) } } else { # there is no "data" if(is.formula(y)) { # if(exists("y") && is.formula(y)) { # F && NULL # F & NULL temp_y <- model.frame(y)[,1] temp_y <- jitter.duplicate(temp_y, jitter_only_positive_duplicates) # notice that the default of the function is to work only with positive values... temp_y_name <- names(model.frame(y))[1] # we must extract the "names" before introducing a new enbironment (or there will be an error) environment(y) <- new.env() assign(temp_y_name, temp_y, environment(y)) # Credit and thanks for doing this goes to Niels Richard Hansen (2 Jan 30, 2011) # http://r.789695.n4.nabble.com/environment-question-changing-variables-from-a-formula-through-model-frame-td3246608.html # warning("Your original variable (in the global environemnt) was just jittered.") # maybe I should add a user input before doing this.... # the_txt <- paste(names(model_frame_y)[1], "temp_y", sep = "<<-") # eval(parse(text = the_txt)) # jutter out y var so to be able to handle identical values. } else { y <- jitter.duplicate(y, jitter_only_positive_duplicates) } } } # the_txt <- paste("print(",names(model_frame_y)[1], ")") # eval(parse(text = the_txt)) # jutter out y var so to be able to handle identical values. # print(ls()) # y should be a formula of the type: y~x, y~a*b # or it could be simply y if(missing(data)) { boxdata <- boxplot(y, plot = plot,range = range ,...) } else { boxdata <- boxplot(y, plot = plot,data = data, range = range ,...) } if(length(boxdata$names) == 1 && boxdata$names =="") boxdata$names <- 1 # this is for cases of type: boxplot(y) (when there is no dependent group) if(length(boxdata$out) == 0 ) { warning("No outliers detected for this boxplot") return(invisible()) } if(!missing(data)) attach(data) # this might lead to problams I should check out for alternatives for using attach here... # creating a data.frame with information from the boxplot output about the outliers (location and group) boxdata_group_name <- factor(boxdata$group) levels(boxdata_group_name) <- boxdata$names[as.numeric(levels(boxdata_group_name))] # the subseting is for cases where we have some sub groups with no outliers if(!is.null(list(...)$at)) { # if the user chose to use the "at" parameter, then we would like the function to still function (added on 19.04.2011) boxdata$group <- list(...)$at[boxdata$group] } boxdata_outlier_df <- data.frame(group = boxdata_group_name, y = boxdata$out, x = boxdata$group) # Let's extract the x,y variables from the formula: if(is.formula(y)) { model_frame_y <- model.frame(y) # old solution: (which caused problems if we used the names parameter when using a 2 way formula... (since the order of the names is different then the levels order we get from using factor) # y <- model_frame_y[,1] # x <- model_frame_y[,-1] y <- model_frame_y[,1] x <- model_frame_y[,-1] if(!is.null(dim(x))) { # then x is a matrix/data.frame of the type x1*x2*..and so on - and we should merge all the variations... x <- apply(x,1, paste, collapse = ".") } } else { # if(missing(x)) x <- rep(1, length(y)) x <- rep(1, length(y)) # we do this in case y comes as a vector and without x } # and put all the variables (x, y, and outlier label name) into one data.frame DATA <- data.frame(label_name, x ,y) if(!is.null(list(...)$names)) { # if the user chose to use the names parameter, then we would like the function to still function (added on 19.04.2011) DATA$x <- factor(DATA$x, levels = unique(DATA$x)) levels(DATA$x) = list(...)$names # enable us to handle when the user adds the "names" parameter # fixed on 19.04.11 # notice that DATA$x must be of the "correct" order (that's why I used split above # warning("Careful, the use of the 'names' parameter is experimental. If you notice any errors please e-mail me at: tal.galili@gmail.com") } if(!missing(data)) detach(data) # we don't need to have "data" attached anymore. # let's only keep the rows with our outliers boxplot.outlier.data <- function(xx, y_name = "y") { y <- xx[,y_name] boxplot_range <- range(boxplot.stats(y, coef = range )$stats) ss <- (y < boxplot_range[1]) | (y > boxplot_range[2]) return(xx[ss,]) } outlier_df <-ddply(DATA, .(x), boxplot.outlier.data) # create propor x/y locations to handle over-laping dots... if(spread_text) { # credit: Greg Snow require(TeachingDemos) temp_x <- boxdata_outlier_df[,"x"] temp_y1 <- boxdata_outlier_df[,"y"] temp_y2 <- temp_y1 for(i in unique(temp_x)) { tmp <- temp_x == i temp_y2[ tmp ] <- spread.labs( temp_y2[ tmp ], 1.3*strheight('A'), maxiter=6000, stepsize = 0.05) #, min=0 ) } } # max(strwidth(c("asa", "a")) # move_text_right <- max(strwidth(outlier_df[,"label_name"])) # plotting the outlier labels :) (I wish there was a non-loop wise way for doing this) for(i in seq_len(dim(boxdata_outlier_df)[1])) { # ss <- (outlier_df[,"x"] %in% boxdata_outlier_df[i,]$group) & (outlier_df[,"y"] %in% boxdata_outlier_df[i,]$y) # if(jitter_if_duplicate) { # ss <- (outlier_df[,"x"] %in% boxdata_outlier_df[i,]$group) & closest.number(outlier_df[,"y"] boxdata_outlier_df[i,]$y) # } else { ss <- (outlier_df[,"x"] %in% boxdata_outlier_df[i,]$group) & (outlier_df[,"y"] %in% boxdata_outlier_df[i,]$y) # } current_label <- outlier_df[ss,"label_name"] temp_x <- boxdata_outlier_df[i,"x"] temp_y <- boxdata_outlier_df[i,"y"] # cbind(boxdata_outlier_df, temp_y2) # outlier_df if(spread_text) { temp_y_new <- temp_y2[i] # not ss move_text_right <- strwidth(current_label) * push_text_right text( temp_x+move_text_right, temp_y_new, current_label, col = label.col) # strwidth segments( temp_x+(move_text_right/6), temp_y, temp_x+(move_text_right*segement_width_as_percent_of_label_dist), temp_y_new ) } else { text(temp_x, temp_y, current_label, pos = 4, col = label.col) } } # outputing some of the information we collected invisible(list(boxdata = boxdata, boxdata_outlier_df = boxdata_outlier_df, outlier_df=outlier_df)) }
To read beforhand
Aim of this document: This sheet has been created to help users to format the TCD file in order to upload it for further calculations.
WARNING: This file and its calculations do not correct automatically the TCD file (task dedicated to the user) but rather to point out the error of the raw TCD file. Before uploading the file in the next calculation (put the name of the function), please check with this document that there is NO error in all the following CONCLUSIONS (this task may require several run of utilisation of the function TCD_cleanR).
WARNING: The weight file and the TCD have to list the sample in the same order.
Cleaning and calculation settings
output$info <- renderUI({ div(column(6, fileInput("TCD", label = p("Select the TCD file")), textInput("nameSession", label = "", value = "Name of the session"), textInput("dateProcessig", label = "", value = "Date of the analysis:"), textInput("Responsible", label = "", value = "Responsible:"), textInput("Temperature", label = "", value = "Lab Temperature:"), textInput("SampleName", label = "", value = "Sample name:"), textInput("system", label = "", value = "System:"), textInput("Column", label = "", value = "Column:"), textInput("temp.Owen", label = "", value = "Temp Owen:") ), (column(6, fileInput("weightData", label = p("Select the weight file")), textInput("carrier.Gas", label = "", value = "Carrier gas:"), textInput("carrier.flow", label = "", value = "Carrier flow:"), textInput("Reference.gas1", label = "", value = "Reference gas 1:"), textInput("Reference.flow1", label = "", value = "Reference flow1:"), textInput("Reference.gas2", label = "", value = "Reference gas 2:"), textInput("Reference.flow2", label = "", value = "Reference flow2:"), textInput("Method", label = "", value = "Method:") ) ) ) }) output$selectSample <- renderUI({ if(!is.null(input$TCD)) { level.identifier.1 <- levels(as.factor(TCD()$Identifier.1)) div(column(12, br(), checkboxGroupInput("sample", label = p("Select the name(s) that correspond to samples"), choices = level.identifier.1, selected = level.identifier.1[1], inline = T ) )) } else {} })
r uiOutput("info")
r uiOutput("selectSample")
TCD <- reactive({ if(!is.null(input$TCD)) { TCD <- read.xls (input$TCD$datapath, sheet = 1, header = TRUE, stringsAsFactors=FALSE) TCD[,3] <- tolower(TCD[,3]) Rank.Analysis <- 2: (nrow(TCD)+ 1) # +1 to make the excel file correspond to the R file TCD <- cbind(Rank.Analysis, TCD) TCD <- as.data.frame(TCD) TCD$rArea.Flash.TCD <- as.numeric(as.character(TCD$rArea.Flash.TCD)) return(TCD) } }) weightData <- reactive({ if(!is.null(input$weightData)) { weightData <- read.xls (input$weightData$datapath, sheet = 1, header = TRUE, stringsAsFactors=FALSE) weightData <- as.data.frame(weightData) weightData$Measured.Weigth..mg. <- as.numeric(as.character(weightData$Measured.Weigth..mg.)) weightData$Box.pos <- as.character(weightData$Box.pos) return(weightData) } }) output$Row_Error <- renderText({ if(!is.null(input$TCD)) { emptyRow <- which(is.null(TCD()$Analysis) | is.na(TCD()$Analysis) | TCD()$Analysis == "" | TCD()$Analysis == " ") if(length(emptyRow) != 0) { toDisplay.1 <- paste("Some Analysis are missing value (DO NOT IGNORE!!). Please check the line(s):", paste((emptyRow +1), sep = " ", collapse = " ")) } else {NULL} } else {} }) output$Row_OK <- renderText({ if(!is.null(input$TCD)) { emptyRow <- which(is.null(TCD()$Analysis) | is.na(TCD()$Analysis) | TCD()$Analysis == "" | TCD()$Analysis == " ") if(length(emptyRow) == 0) { toDisplay.1 <- "No problem in the Analysis column" } else {} } else {} }) ############################ ## Condition 2: rArea Flash TCD with exactly three lines ############################ resultMatrix <- reactive({ if(!is.null(input$TCD)) { sample <- input$sample TCD.liste <- split(TCD(), TCD()$Analysis) resultMatrix <- matrix(NA,ncol = 14) #the matrix summurizing the number of values in the rArea for(i in 1:length(TCD.liste)) { One.Analysis <- TCD.liste[[i]] # is there some row that are empty? Analysis_vide <- length(which(One.Analysis$Row == "" | is.na(One.Analysis$Row) | is.null(One.Analysis$Row))) # is there some difference Row (1 = all the Identifier.1 are identicals, > 1 at least one line has a different Identifier.1) Analysis_diff <- length(unique(One.Analysis$Row)) # is there some identifier.1 that are empty? (id1_vide = nb of cell empty) id1_vide <- length(which(One.Analysis$Identifier.1 == "" | is.na(One.Analysis$Identifier.1) | is.null(One.Analysis$Identifier.1))) # is there some difference identifier.1 (1 = all the Identifier.1 are identicals, > 1 at least one line has a different Identifier.1) id1_diff <- length(unique(One.Analysis$Identifier.1)) # is there some difference identifier.2 (1 = all the Identifier.2 are identicals, > 1 at least one line has a different Identifier.2) id2_diff <- length(unique(One.Analysis$Identifier.2)) # id2_vide for a sample = number of empty cells, for standard = number of not empty cells, if there is several id1 (so the identifity of the analysis is not very well known as a sample or a standard), id2_vide = 1 if(id1_vide != 0 | id1_diff > 1){ id2_vide <- 1 id2_diff <- 1 } else if(is.element(One.Analysis$Identifier.1[1], sample)){ # is there some identifier.2 that are empty? (id2_vide = nb of cell empty) id2_vide <- length(which(One.Analysis$Identifier.2 == "" | is.na(One.Analysis$Identifier.2) | is.null(One.Analysis$Identifier.2))) } else { id2_vide <- length(which(One.Analysis$Identifier.2 != "" & !is.na(One.Analysis$Identifier.2) & !is.null(One.Analysis$Identifier.2))) } # nb of rArea value that are empty cells nb.NA <- length(which(is.na(One.Analysis$rArea.Flash.TCD) | is.null(One.Analysis$rArea.Flash.TCD) | One.Analysis$rArea.Flash.TCD == "")) # nb of rArea value that are not empty cells (if nbValue == 0 everything is ok, nbValue = 1 errror) value <- length(which(!is.na(One.Analysis$rArea.Flash.TCD) & !is.null(One.Analysis$rArea.Flash.TCD) & One.Analysis$rArea.Flash.TCD != "")) level.identifier.1 <- levels(as.factor(TCD()$Identifier.1)) if(One.Analysis$Identifier.1[1] == "sucrose") { if(value == 1) { nbValue <- 0 } else { nbValue <- 1 } } else { if(value == 2) { nbValue <- 0 } else { nbValue <- 1 } } # nb value that are non numeric notEmpty <- which(!is.na(One.Analysis$rArea.Flash.TCD) & !is.null(One.Analysis$rArea.Flash.TCD) & One.Analysis$rArea.Flash.TCD != "") vect <- One.Analysis$rArea.Flash.TCD[notEmpty] if(length(vect) == 0) { nbCharacter <- 0 } else { tempResult <- sapply(1:length(vect), function(x) { toTest <- as.numeric(as.character(vect[x])) return(is.na(toTest)) }) if(length(which(tempResult == T)) != 0) { nbCharacter <- 1 } else { nbCharacter <- 0 } } toAdd <- c(as.character(One.Analysis$Identifier.1[1]), as.character(One.Analysis$Identifier.2)[1], One.Analysis$Rank.Analysis[1], Analysis_vide, Analysis_diff, id1_vide, id1_diff, id2_vide, id2_diff, nbValue, nb.NA, nbCharacter, One.Analysis$rArea.Flash.TCD[1:2]) resultMatrix <- resultMatrix <- rbind(resultMatrix, toAdd) } resultMatrix <- resultMatrix[-1,] colnames(resultMatrix) <- c("Identifier.1", "Identifier.2","FirstLine", "Analysis_vide", "Analysis_diff", "id1_vide", "id1_diff", "id2_vide", "id2_diff", "nbValue", "Nb.NA", "nbCharacter","rArea.Flash.TCD.N", "rArea.Flash.TCD.C") rownames(resultMatrix) <- 1:nrow(resultMatrix) resultMatrix <- as.data.frame(resultMatrix) for(i in 3:ncol(resultMatrix)) { resultMatrix[,i] <- as.numeric(as.character(resultMatrix[,i])) } resultMatrix <- resultMatrix[order(resultMatrix[,3]),] return(resultMatrix) } else {} }) ############################ ## Condition 1Bis: nb analysis ############################ output$Analysis_Error <- renderText({ if(!is.null(input$TCD)) { Analysis_vide <- which(resultMatrix()$Analysis_vide != 0) if(length(Analysis_vide) != 0) { toDisplay.1 <- paste("Some rows are empty. Please check the line(s):", paste(resultMatrix()$FirstLine[Analysis_vide], sep = " ", collapse = " ")) } else {NULL} } else {} }) output$Analysis_OK <- renderText({ if(!is.null(input$TCD)) { Analysis_vide <- which(resultMatrix()$Analysis_vide != 0) if(length(Analysis_vide) == 0) { toDisplay.1 <- "No empty row name" } else {} } else {} }) output$AnalysisDiff_Error <- renderText({ if(!is.null(input$TCD)) { print(resultMatrix()$FirstLine[which(resultMatrix()$Analysis_diff != 1)]) Analysis_diff <- resultMatrix()$FirstLine[which(resultMatrix()$Analysis_diff != 1)] if(length(Analysis_diff) != 0) { toDisplay.1 <- paste("Some rows do not have the same name. Please check the analysis beginning line(s)", paste(Analysis_diff, sep = " ", collapse = " ")) } else {NULL} } else {} }) output$AnalysisDiff_OK <- renderText({ if(!is.null(input$TCD)) { Analysis_diff <- resultMatrix()$FirstLine[which(resultMatrix()$Analysis_diff != 1)] if(length(Analysis_diff) == 0) { toDisplay.1 <-"Awesome! All the row names are similar in a single analysis." } else {} } else {} }) ############################ ## Condition 1: identifier.1 ############################ output$id1_Error <- renderText({ if(!is.null(input$TCD)) { id1_vide <- which(resultMatrix()$id1_vide != 0) if(length(id1_vide) != 0) { toDisplay.1 <- paste("Some identifier.1 are empty. Please check the analysis beginning line(s):", paste(resultMatrix()$FirstLine[id1_vide], sep = " ", collapse = " ")) } else {NULL} } else {} }) output$id1_OK <- renderText({ if(!is.null(input$TCD)) { id1_vide <- which(resultMatrix()$id1_vide != 0) if(length(id1_vide) == 0) { toDisplay.1 <- "No identifier.1 is empty" } else {} } else {} }) output$id1Diff_Error <- renderText({ if(!is.null(input$TCD)) { id1_diff <- resultMatrix()$FirstLine[which(resultMatrix()$id1_diff != 1)] if(length(id1_diff) != 0) { toDisplay.1 <- paste("Some identifier.1 do not have the same name. Please check the the analysis beginning line(s):", paste(id1_diff, sep = " ", collapse = " ")) } else {NULL} } else {} }) output$id1Diff_OK <- renderText({ if(!is.null(input$TCD)) { id1_diff <- resultMatrix()$FirstLine[which(resultMatrix()$id1_diff != 1)] if(length(id1_diff) == 0) { toDisplay.1 <-"All the identifier.1 have the same name in a single analysis, That's great !" } else {} } else {} }) ############################ ## Condition 2: identifier.2 ############################ output$error_id.2_Error <- renderText({ if(!is.null(input$TCD)) { error_id.2 <- resultMatrix()$FirstLine[which(resultMatrix()$id2_vide != 0)] if(length(error_id.2) != 0) { paste("Some analysis show empty identifier.2. Please check in the analysis beginning line(s)", paste(error_id.2, sep = " ", collapse = " ")) } else {} } else {} }) output$error_id.2_OK <- renderText({ if(!is.null(input$TCD)) { error_id.2 <- resultMatrix()$FirstLine[which(resultMatrix()$id2_vide != 0)] if(length(error_id.2) == 0) { "Good, all the identifier.2 have a value!" } else {} } else {} }) output$error.id2.sample_Error <- renderText({ if(!is.null(input$TCD)) { error.id2.sample <- resultMatrix()$FirstLine[which(resultMatrix()$id2_diff != 1)] if(length(error.id2.sample) != 0) { paste("Some analysis show different name in their identifier.2. Please check in the analysis beginning line(s)", paste(error.id2.sample, sep = " ", collapse = " ")) } else {} } else {} }) output$error.id2.sample_OK <- renderText({ if(!is.null(input$TCD)) { error.id2.sample <- resultMatrix()$FirstLine[which(resultMatrix()$id2_diff != 1)] if(length(error.id2.sample) == 0) { "No error in the names of the identifier.2, great :)" } else {} } else {} }) ############################ ## Condition 3: r.Area ############################ output$error.nbValue_Error <- renderText({ if(!is.null(input$TCD)) { error.nbValue <- resultMatrix()$FirstLine[which(resultMatrix()$nbValue != 0)] if(length(error.nbValue) > 0) { paste("There is a mistake in the number of values. Check the analysis beginning line(s):", paste(error.nbValue, sep = " ", collapse = " ")) } else {} } else {} }) output$error.nbValue_OK <- renderText({ if(!is.null(input$TCD)) { error.nbValue <- resultMatrix()$FirstLine[which(resultMatrix()$nbValue != 0)] if(length(error.nbValue) == 0) { "There is a no mistake in the number of values" } else {} } else {} }) output$error.nbNA_Error <- renderText({ if(!is.null(input$TCD)) { error.nbNA <- resultMatrix()$FirstLine[which(resultMatrix()$Nb.NA != 1)] if(length(error.nbNA) > 0) { paste("There is a mistake in the number of NA value. Check the analysis beginning line(s):", paste(error.nbNA, sep = " ", collapse = " ")) } else {} } else {} }) output$error.nbNA_OK <- renderText({ if(!is.null(input$TCD)) { error.nbNA <- resultMatrix()$FirstLine[which(resultMatrix()$Nb.NA != 1)] if(length(error.nbNA) == 0) { "There is a no mistake in the number of NA" } else {} } else {} }) output$character_Error <- renderText({ if(!is.null(input$TCD)) { TCD <- read.xls (input$TCD$datapath, sheet = 1, header = TRUE, stringsAsFactors=FALSE) weightData <- read.xls (input$weightData$datapath, sheet = 1, header = TRUE, stringsAsFactors=FALSE) errorChar_TCD <- containsCharacter(TCD$rArea.Flash.TCD) errorChar_Weight <- containsCharacter(weightData$Measured.Weigth..mg.) if(length(errorChar_TCD) > 0) { paste("Oups, there is a character string in your TCD file. Check the line(s):", paste(TCD()$Rank.Analysis[errorChar_TCD], sep = " ", collapse = " ")) } else { if(length(errorChar_Weight) > 0) { paste("Oups, there is a character string in your Weight file. Check the line(s):", paste(errorChar_Weight, sep = " ", collapse = " ")) } else {} } } else {} }) output$character_OK <- renderText({ if(!is.null(input$TCD)) { TCD <- read.xls (input$TCD$datapath, sheet = 1, header = TRUE, stringsAsFactors=FALSE) weightData <- read.xls (input$weightData$datapath, sheet = 1, header = TRUE, stringsAsFactors=FALSE) errorChar_TCD <- containsCharacter(TCD$rArea.Flash.TCD) errorChar_Weight <- containsCharacter(weightData$Measured.Weigth..mg.) if(length(errorChar_TCD) == 0 & length(errorChar_Weight) == 0) { "Perfect!! There is no character in your files" } else {} } else {} }) ############################ ## Condition 3: For sample, all identifier.2 of a single analysis should be not empty and identical ############################ dataTables <- reactive({ if(!is.null(input$TCD)) { sample <- input$sample place <- NULL for(x in 1:length(sample)) { if(x == 1) { TCD.sample <- resultMatrix()[which(resultMatrix()$Identifier.1 == sample[x]), ] place <- which(resultMatrix()$Identifier.1 == sample[x]) } else { TCD.sample <- rbind(TCD.sample, resultMatrix()[which(resultMatrix()$Identifier.1 == sample[x]), ]) place <- c(place, which(resultMatrix()$Identifier.1 == sample[x])) } } place <- sort(place) PlaceBar <- complementVector(1:nrow(resultMatrix()), place) TCD.sample <- TCD.sample[order(TCD.sample$FirstLine),] # data with only the sample TCD.standard <- resultMatrix()[PlaceBar, ] # data with only the standards return(list(TCD.sample, TCD.standard)) } else {} }) dataStandard <- reactive({ if(!is.null(input$TCD)) { dataTables()[[2]] } else {} }) dataSample <- reactive({ if(!is.null(input$TCD)) { dataTables()[[1]] } else {} }) output$dataSampleToPrint <- renderDT({ if(!is.null(input$TCD)) { dataSample()[,c(1,2, (ncol(dataSample()) -1), ncol(dataSample()))] } else {} }) output$dataStandardToPrint <- renderDT({ if(!is.null(input$TCD)) { dataStandard()[,c(1,2, (ncol(dataSample()) -1), ncol(dataSample()))] } else {} }) ############################ ## Condition 4: identifier.2 for weight and TCD file shoule be in the same order ############################ Data_plus_weight <- reactive({ ## for pasting the weight of the sample if(!is.null(input$TCD) & !is.null(input$weightData)) { errorToCount <- 0 # flag for error line.flag <- NA Data_plus_weight <- NULL nRow.dataSample <- nrow(dataSample()) nRow.weightData <- nrow(weightData()) if(nRow.dataSample != nRow.weightData) { errorToCount <- 1 } else { for(i in 1:nRow.dataSample){ if(as.character(dataSample()$Identifier.2[i]) != as.character(weightData()$Box.pos[i])){ errorToCount <- 1 line.flag <- dataSample()$FirstLine[i] } else {} } if(errorToCount == 0) { Data_plus_weight <- cbind(dataSample(), weightData()$Name, weightData()$Measured.Weigth..mg.) Data_plus_weight <- as.data.frame(Data_plus_weight) colnames(Data_plus_weight) <- c(colnames(dataSample()), "sampleName", "SampleWeight") } else {} } return(list(c(errorToCount, line.flag), Data_plus_weight)) } else {} }) output$toChec2k <- renderTable({ dataSample()$Rank.Analysis }) output$weight_Error <- renderText({ if(!is.null(input$TCD) & !is.null(input$weightData)) { if(Data_plus_weight()[[1]][1] != 0){ if(!is.na(Data_plus_weight()[[1]][2])){ paste("Weight and TCD files do not match on their identifier.2 (DON'T IGNORE THIS ERROR), check line(s):", paste(Data_plus_weight()[[1]][2], sep = " ", collapse = " ")) } else { paste("Weight and TCD files do not have the same number of rows (DON'T IGNORE THIS ERROR)") } } else { NULL } } else {} }) output$weight_OK <- renderText({ if(!is.null(input$TCD) & !is.null(input$weightData)) { if(Data_plus_weight()[[1]][1] != 0){ NULL } else { "The weight file seems correct (Note that it did not check for the box name)" } } else {} })
Conditions tested for cleaning
- Condition 1: Check that there are no missing Analysis number (definition of a single analysis)
r textOutput("Row_OK")r textOutput("Row_Error") - Condition 2: Check that all analysis has only one single row name and that none of these cells are empty
r textOutput("Analysis_OK")r textOutput("Analysis_Error")r textOutput("AnalysisDiff_OK")r textOutput("AnalysisDiff_Error") - Condition 3: Check that all analysis has only one single Identifier 1 and that none of these cells are empty
r textOutput("id1_OK")r textOutput("id1_Error")r textOutput("id1Diff_OK")r textOutput("id1Diff_Error") - Condition 4: Check that all analysis has only one single Identifier 2 and that none of these cells are empty
r textOutput("error_id.2_Error")r textOutput("error_id.2_OK")r textOutput("error.id2.sample_Error")r textOutput("error.id2.sample_OK") - Condition 5: Check that rArea Flash TCD has exactly three lines (except for the sucrose that has only two lines) cand contains exactly two values (respectively one) and an empty cell
r textOutput("error.nbValue_OK")r textOutput("error.nbValue_Error")r textOutput("error.nbNA_OK")r textOutput("error.nbNA_Error") - Condition 6: Check that the order of the samples are the same between the TCD and weight files
r textOutput("weight_Error")r textOutput("weight_OK") - Condition 7: Check that weight of the samples and rArea values do not contain any character
r textOutput("character_OK")r textOutput("character_Error")
Data Samples:
r DTOutput("dataSampleToPrint")
Data Standards:
r DTOutput("dataStandardToPrint")
Graphical detection of mistakes - Outlier highlighting
output$forBoxPlot <- renderUI({ if(!is.null(input$TCD)) { level.identifier.1 <- levels(as.factor(TCD()$Identifier.1)) checkboxGroupInput("toDisplay", label = "", choices = level.identifier.1, selected = level.identifier.1, inline = T ) } else {} }) output$boxplot <- renderPlot({ if(!is.null(input$TCD)) { toDisplay <- input$toDisplay for(x in 1:length(toDisplay)) { if(x == 1) { dataTemp <- resultMatrix()[which(resultMatrix()$Identifier.1 == toDisplay[x]), ] } else { dataTemp <- rbind(dataTemp, resultMatrix()[which(resultMatrix()$Identifier.1 == toDisplay[x]), ]) } } par(mfrow = c(1,2), mar = c(2,3,1.2,1.2)) ylim.C <- c(min(dataTemp$rArea.Flash.TCD.C, na.rm = T) - abs(min(dataTemp$rArea.Flash.TCD.C, na.rm = T))*0.1, max(dataTemp$rArea.Flash.TCD.C, na.rm = T) + abs(max(dataTemp$rArea.Flash.TCD.C, na.rm = T))*0.1) boxplot.with.outlier.label(as.numeric(as.character(dataTemp$rArea.Flash.TCD.C)), label_name = dataTemp$Identifier.2, ylim = ylim.C, cex = 1.25) mtext("rArea.Flash.TCD.C", side = 1) ylim.N <- c(min(dataTemp$rArea.Flash.TCD.N, na.rm = T) - abs(min(dataTemp$rArea.Flash.TCD.N, na.rm = T))*0.1, max(dataTemp$rArea.Flash.TCD.N, na.rm = T) + abs(max(dataTemp$rArea.Flash.TCD.N, na.rm = T))*0.1) boxplot.with.outlier.label(as.numeric(as.character(dataTemp$rArea.Flash.TCD.N)), label_name = dataTemp$Identifier.2, ylim = ylim.N, cex = 1.25) mtext("rArea.Flash.TCD.N", side = 1) } else {} })
r uiOutput('forBoxPlot')
r plotOutput('boxplot')
Conclusions of the cleaning
finalConclusion <- reactive({ if(!is.null(resultMatrix())) { id1_vide <- which(resultMatrix()$id1_vide != 0) id1_diff <- resultMatrix()$FirstLine[which(resultMatrix()$id1_diff != 1)] error_id.2 <- resultMatrix()$FirstLine[which(resultMatrix()$id2_vide != 0)] error.id2.sample <- resultMatrix()$FirstLine[which(resultMatrix()$id2_diff != 1)] error.nbValue <- resultMatrix()$FirstLine[which(resultMatrix()$nbValue != 0)] error.nbNA <- resultMatrix()$FirstLine[which(resultMatrix()$Nb.NA != 1)] errorChar <- resultMatrix()$FirstLine[which(resultMatrix()$nbCharacter != 0)] Analysis_vide <- which(resultMatrix()$Analysis_vide != 0) Analysis_diff <- resultMatrix()$FirstLine[which(resultMatrix()$Analysis_diff != 1)] if(!is.null(Data_plus_weight())) { if(length(Analysis_vide) != 0 | length(Analysis_diff) != 0 | length(id1_vide) != 0 | length(id1_diff) != 0 | length(error_id.2) != 0 | length(error.id2.sample) != 0 | Data_plus_weight()[[1]][1] != 0 | length(error.nbNA) != 0 | length(errorChar) != 0 |length(error.nbValue) != 0 ) { return(TRUE) } else {return(FALSE)} } else {return(TRUE)} } else {return(TRUE)} }) output$finalConclusion_error <- renderText({ if(!is.null(resultMatrix())) { if(finalConclusion() == TRUE) { "There is at least one mistake in your files. <br> Please correct according to previously before continuing to read this file." } else {NULL} } else {NULL} }) output$finalConclusion_OK <- renderText({ if(!is.null(resultMatrix())) { if(finalConclusion() == FALSE) { "It seems that your files are correct." } else {NULL} } else {NULL} })
r textOutput("finalConclusion_OK")
r span(htmlOutput("finalConclusion_error"), style="color:red")
Settings for "Quant.file" creation
WARNING: Before continuing in this file, please check the conditions above do NOT contain any error in required CONCLUSIONS (this task may require several run of utilisation of the function TCD_cleanR). If the TCD file is upload without this last verification, Quant.CreatR CANNOT garantee the validity of the following data.
r uiOutput("info.2")
output$info.2 <- renderUI({ backgroundValues <- c(0, 1167) content.GelA <- c(0.16, 0.42) gelA <- levels(as.factor(Data_plus_weight_table()$sampleName))[(str_detect(levels(as.factor(Data_plus_weight_table()$sampleName)), "el")| str_detect(levels(as.factor(Data_plus_weight_table()$sampleName)), "EL"))] if(length(gelA) == 0) { gelA <- levels(as.factor(Data_plus_weight_table()$sampleName))[1] } div(column(6, textInput("N.background", label = "N background value for Area.Flash.TCD.N", value = backgroundValues[1]), textInput("N.gelA", label = "GelA N content", value = content.GelA[1]) ), (column(6, textInput("C.background", label = "C background value for Area.Flash.TCD.C", value = backgroundValues[2]), textInput("C.gelA", label = "GelA C content", value = content.GelA[2]) ) ), column(12, checkboxGroupInput("gelA.Name.input", label = p("Choose the name that correspond to GelA"), choices = levels(as.factor(Data_plus_weight_table()$sampleName)), selected = gelA, inline =T) ) ) }) backgroundValues <- reactive({ return(c(as.numeric(as.character(input$N.background)), as.numeric(as.character(input$C.background)))) }) Data_plus_weight_table <- reactive({ if(!is.null(Data_plus_weight())) { tempTable <- data.frame(Data_plus_weight()[[2]]$Identifier.1, Data_plus_weight()[[2]]$Identifier.2, Data_plus_weight()[[2]]$sampleName, Data_plus_weight()[[2]]$SampleWeight, Data_plus_weight()[[2]]$rArea.Flash.TCD.N, Data_plus_weight()[[2]]$rArea.Flash.TCD.C) Rank.Analysis <- 1:nrow(tempTable) tempTable <- cbind(Rank.Analysis, tempTable) colnames(tempTable) <- c("Rank.Analysis","Identifier.1", "Identifier.2", "sampleName", "SampleWeight", "rArea.Flash.TCD.N", "rArea.Flash.TCD.C") return(tempTable) } else {} }) content.GelA <- reactive({ return(c(as.numeric(as.character(input$N.gelA)), as.numeric(as.character(input$C.gelA)))) }) Data_plus_weight_corrected <- reactive({ if(!is.null(Data_plus_weight_table())) { corrected.N <- Data_plus_weight_table()$rArea.Flash.TCD.N - backgroundValues()[1] corrected.C <- Data_plus_weight_table()$rArea.Flash.TCD.C - backgroundValues()[2] temp <- data.frame(Data_plus_weight_table(), corrected.N, corrected.C) colnames(temp)[8:9] <- c("Corrected.Area.N", "Corrected.Area.C") return(temp) } else {} }) GelA.table <- reactive({ if(!is.null(Data_plus_weight_table())) { for(x in 1:length(input$gelA.Name.input)) { if(x == 1) { gelA <- Data_plus_weight_corrected()[which(Data_plus_weight_corrected()$sampleName == input$gelA.Name.input[x]), ] } else { gelA <- rbind(gelA, Data_plus_weight_corrected()[which(Data_plus_weight_corrected()$sampleName == input$gelA.Name.input[x]), ]) } } temp <- matrix() for(x in 1: (nrow(gelA) + 1)) { if(x == 1) { temp <- c(0, "Blank", as.character("Blank"), as.character("Blank"), 0, as.numeric(as.character(backgroundValues())), as.numeric(as.character(backgroundValues()))) } else { temp <- rbind(temp, gelA[x-1, ]) } } temp[,5] <- as.numeric(as.character(temp[,5])) temp[1,5] <- 0 mg.N.perCup <- as.numeric(as.character(temp$SampleWeight)) * content.GelA()[1] * 1000 mg.C.perCup <- as.numeric(as.character(temp$SampleWeight)) * content.GelA()[2] * 1000 temp <- cbind(temp, mg.N.perCup, mg.C.perCup) temp$Rank.Analysis <- as.numeric(as.character(temp$Rank.Analysis)) temp <- temp[order(temp$Rank.Analysis), ] colnames(temp) <- c(colnames(Data_plus_weight_corrected()), "mg.N.perCup", "mg.C.perCup") temp2 <- c("Blank", as.character(temp[,3])) temp[,3] <- temp2[-2] temp3 <- c("Blank", as.character(temp[,4])) temp[,4] <- temp3[-2] return(temp) } else {} })
GelA linear regression
1. Nitrogen
output$GelA.tokeep.N <- renderUI({ if(!is.null(Data_plus_weight_table())) { checkboxGroupInput("GelA.tokeep.N", label = p("Select the gelA to keep for the linear regression"), choices = GelA.table()$Identifier.2, selected = GelA.table()$Identifier.2, inline = T ) } else {} }) tableGelA.tokeep.N <- reactive({ if(!is.null(Data_plus_weight_table())) { for(x in 1:length(input$GelA.tokeep.N)) { if(x == 1) { tableGelA.tokeep.N <- GelA.table()[which(GelA.table()$Identifier.2 == input$GelA.tokeep.N[x]), ] } else { tableGelA.tokeep.N <- rbind(tableGelA.tokeep.N, GelA.table()[which(GelA.table()$Identifier.2 == input$GelA.tokeep.N[x]), ]) } } return(tableGelA.tokeep.N) } else {} }) model.N <- reactive({ model.N.NR <- lm(as.numeric(as.character(tableGelA.tokeep.N()$rArea.Flash.TCD.N)) ~ as.numeric(as.character(tableGelA.tokeep.N()$mg.N.perCup)) + 0) Slope.N <- model.N.NR$coefficients return(Slope.N) }) output$linearRegression.N <- renderPlot({ plot(as.numeric(as.character(tableGelA.tokeep.N()$rArea.Flash.TCD.N)) ~ as.numeric(as.character(tableGelA.tokeep.N()$mg.N.perCup)), ylab = "rArea.Flash.TCD.N", xlab = "mg.N.perCup") text(as.numeric(as.character(tableGelA.tokeep.N()$mg.N.perCup)), as.numeric(as.character(tableGelA.tokeep.N()$rArea.Flash.TCD.N)), labels=as.character(tableGelA.tokeep.N()$Identifier.2), cex= 0.7, pos=4) abline(a = 0, b = model.N(), col = 'red') }) output$modelN <- renderText({ paste("For N, the slope of the model:", round(model.N(),2)) })
r uiOutput("GelA.tokeep.N")
r plotOutput('linearRegression.N')
r textOutput('modelN')
2. Carbon
output$GelA.tokeep.C <- renderUI({ if(!is.null(Data_plus_weight_table())) { checkboxGroupInput("GelA.tokeep.C", label = p("Select the gelA to keep for the linear regression"), choices = GelA.table()$Identifier.2, selected = GelA.table()$Identifier.2, inline = T ) } else {} }) tableGelA.tokeep.C <- reactive({ if(!is.null(Data_plus_weight_table())) { for(x in 1:length(input$GelA.tokeep.C)) { if(x == 1) { tableGelA.tokeep.C <- GelA.table()[which(GelA.table()$Identifier.2 == input$GelA.tokeep.C[x]), ] } else { tableGelA.tokeep.C <- rbind(tableGelA.tokeep.C, GelA.table()[which(GelA.table()$Identifier.2 == input$GelA.tokeep.C[x]), ]) } } return(tableGelA.tokeep.C) } else {} }) output$toCheck <- renderTable({ # tableGelA.tokeep.C() }) model.C <- reactive({ model.C.NR <- lm(as.numeric(as.character(tableGelA.tokeep.C()$rArea.Flash.TCD.C)) ~ as.numeric(as.character(tableGelA.tokeep.C()$mg.C.perCup)) + 0) Slope.C <- model.C.NR$coefficients return(Slope.C) }) output$linearRegression.C <- renderPlot({ plot(as.numeric(as.character(tableGelA.tokeep.C()$rArea.Flash.TCD.C)) ~ as.numeric(as.character(tableGelA.tokeep.C()$mg.C.perCup)), ylab = "rArea.Flash.TCD.C", xlab = "mg.C.perCup") text(as.numeric(as.character(tableGelA.tokeep.C()$mg.C.perCup)), as.numeric(as.character(tableGelA.tokeep.C()$rArea.Flash.TCD.C)), labels=as.character(tableGelA.tokeep.C()$Identifier.2), cex= 0.7, pos=4) abline(a = 0, b = model.C(),col = 'red') }) output$modelC <- renderText({ paste("For C, the slope of the model: ", round(model.C(),2)) })
r uiOutput("GelA.tokeep.C")
r tableOutput("toCheck")
r plotOutput('linearRegression.C')
r textOutput('modelC')
Creation of the final "Quant" file
finalTable.Sample <- reactive({ if(!is.null(Data_plus_weight_table())) { Weight.N.perCup <- Data_plus_weight_corrected()$Corrected.Area.N/model.N() Weight.C.perCup <- Data_plus_weight_corrected()$Corrected.Area.C/model.C() Weight.N.kg <- Weight.N.perCup/Data_plus_weight_corrected()$SampleWeight*1000 Weight.C.kg <- Weight.C.perCup/Data_plus_weight_corrected()$SampleWeight*1000 C.N.Ratio <- (Weight.C.kg/12)/(Weight.N.kg/14) temporary.TCDtable <- cbind(Data_plus_weight_corrected(),Weight.N.perCup, Weight.C.perCup, Weight.N.kg, Weight.C.kg, C.N.Ratio) for(i in 5:12) { temporary.TCDtable[,i] <- as.numeric(as.character(temporary.TCDtable[,i])) } return(temporary.TCDtable) } else {} }) output$tableSample.ToDisplay <- renderDT({ if(!is.null(Data_plus_weight_table())) { return(finalTable.Sample()) } else {} }) output$nameFile <- renderText({ if(!is.null(Data_plus_weight_table())) { if(input$nameSession == "Name of the session") { toAdd <- "" } else { toAdd <- input$nameSession } paste("This table has already been saved in an excel sheet called: ", paste0("finalTable.Sample_",toAdd, ".csv" )) } else {} }) output$SaveButton <- renderUI({ actionButton("save", "Save the data") }) output$Save <- renderUI({ if(!is.null(input$save)) { if(input$save > 0){ isolate({ if(input$nameSession == "Name of the session") { toAdd <- "" } else { toAdd <- paste0("_", input$nameSession) } table0 <- matrix("", 24, 2) table0[,1] <- c("Total C and D Quantification Analysis", "", "1. Session settings", "Date", "Samples", "Responsible", "Lab. Temp", "System", "Column", "Temp, Owen", "Carrier gas", "Carrier flow", "Reference gas1", "Reference flow", "Reference gas2", "Reference flow", "Method", "Content of N in Gel A house standard", "Content of C in Gel A house standard", "N background value for Area.Flash.TCD.N", "C background value for Area.Flash.TCD.C", "", "", "2. GelA table" ) table0[,2] <- c("", "", "", input$dateProcessig, input$SampleName, input$Responsible, input$Temperature, input$system, input$Column, input$temp.Owen, input$carrier.Gas, input$carrier.flow, input$Reference.gas1, input$Reference.flow1, input$Reference.gas2, input$Reference.flow2, input$Method, input$N.gelA, input$C.gelA, input$N.background, input$C.background, "", "", "" ) normStyle <- createStyle(valign = "center", halign = "center", numFmt = "0.00") GeneraltitleStyle <- createStyle(valign = "center", halign = "center", fontSize = 14, textDecoration = "bold") titleStyle <- createStyle(valign = "center", halign = "left", fontSize = 14, textDecoration = "bold") tableStyle <- createStyle(borderStyle = "thin", border = "TopBottomLeftRight") colorPurple <- createStyle(fgFill = "#800080") colorGreen <- createStyle(fgFill = "#99cc00") table.Interm1 <- matrix("3. General Table", ncol = 1, nrow = 1) wb <- createWorkbook("Example.xlsx") addWorksheet(wb, "TCD_data") writeData(wb, sheet = 1, TCD(), colNames = T) addWorksheet(wb, "quantification_data") writeData(wb, sheet = 2, table0, colNames = FALSE) writeData(wb, sheet = 2, GelA.table(), startRow = nrow(table0) + 1, colNames = T) writeData(wb, sheet = 2, table.Interm1, startRow = nrow(table0) + 4 + nrow(GelA.table()), colNames = F) writeData(wb, sheet = 2, finalTable.Sample(), startRow = nrow(table0) + 5 + nrow(GelA.table()), colNames = T) nbRow_FinalTable <- nrow(table0) + 5 + nrow(GelA.table()) + nrow(finalTable.Sample()) lapply(1:14, function(x) { addStyle(wb, sheet = 2, normStyle, cols = x, rows = 1:nbRow_FinalTable) }) lapply(1:11, function(x) { addStyle(wb, sheet = 2, tableStyle, cols = x, rows = 25:(25+nrow(GelA.table())), stack = T) }) finalTable_begin <- nrow(table0) + 5 + nrow(GelA.table()) finalTable_end <- nrow(table0) + 5 + nrow(GelA.table()) + nrow(finalTable.Sample()) lapply(1:14, function(x) { addStyle(wb, sheet = 2, tableStyle, cols = x, rows = finalTable_begin:finalTable_end, stack = T) }) addStyle(wb, sheet = 2, GeneraltitleStyle, rows = 1, cols = 1, stack = T) addStyle(wb, sheet = 2, titleStyle, rows = 3, cols = 1, stack = T) addStyle(wb, sheet = 2, titleStyle, rows = nrow(table0), cols = 1, stack = T) addStyle(wb, sheet = 2, titleStyle, rows = nrow(table0) + 4 + nrow(GelA.table()), cols = 1, stack = T) addStyle(wb, sheet = 2, colorPurple, cols = 12, rows = finalTable_begin:finalTable_end, stack = T) addStyle(wb, sheet = 2, colorPurple, cols = 13, rows = finalTable_begin:finalTable_end, stack = T) addStyle(wb, sheet = 2, colorGreen, cols = 14, rows = finalTable_begin:finalTable_end, stack = T) mergeCells(wb, sheet = 2, cols = 1:18, rows = 1) mergeCells(wb, sheet = 2, cols = 1:8, rows = 3) mergeCells(wb, sheet = 2, cols = 1:8, rows = nrow(table0)) mergeCells(wb, sheet = 2, cols = 1:8, rows = nrow(table0) + 4 + nrow(GelA.table())) if(Sys.info()[1] == "Windows"){ path <- choose.dir() } else { path <- jchoose.dir() } pathExport <- paste0(path, "/QuantFile",toAdd, ".xlsx") saveWorkbook(wb, file = pathExport, overwrite = TRUE) }) return("Your results have been saved :)") } else {} } else {} })
Final Sample table
r DTOutput('tableSample.ToDisplay')
r uiOutput("SaveButton")
r uiOutput("Save")
Data exploration
output$pivot <- renderRpivotTable({ rpivotTable(finalTable.Sample(),width="100%", height="400px") })
r rpivotTableOutput('pivot')
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.