##############################################################
#
# elementR 1.3.3
#
# charlott.sirot@gmail.com
# francois.guilhaumon@ird.fr
#
#####################################################################
runElementR <- function(){ # nocov start
######################
############### GLOBAL
######################
#skyn
skin <- Sys.getenv("DASHBOARD_SKIN")
skin <- tolower(skin)
if (skin == "") skin <- "blue"
menuIconClass <- "fa-lg"
######################
############ FUNCTIONS
######################
##################################################################################################
# Name: checkFormat
# function: check the format (i.e. the extension) of the file uploaded
# input : files = the path of the session uploaded
# output: A logical value, FALSE = error, TRUE = no error
##################################################################################################
checkFormat <- function(files){
files <- list.files(files, recursive = TRUE)
ref <- NULL
for(x in seq(from = 1, to = length(files), by = 1)){
if(str_detect(files[x], ".xlsx")){
ref <- c(ref, TRUE)
} else if(str_detect(files[x], ".xls")){
ref <- c(ref, TRUE)
} else if(str_detect(files[x], ".ods")){
ref <- c(ref, TRUE)
} else if(str_detect(files[x], ".csv")){
ref <- c(ref, TRUE)
} else {
ref <- c(ref, FALSE)
}
}
if(length(which(ref == FALSE)) == !0){
res <- FALSE
} else {
res <- TRUE
}
return(res)
}
##################################################################################################
# Name: readData
# function: detect the format of the data and read the table
# input : x = a character string of the path of the data
# output: a matrix
##################################################################################################
readData <- function(x, sep = ";", dec = "."){
if(str_detect(x, ".xls")){
df <- as.data.frame(read_excel(x, sheet = 1, col_names = TRUE))
}
if(str_detect(x, ".csv")){
df <- read.table(x, header = TRUE, sep = sep, dec = dec)
}
if(str_detect(x, ".ods")){
df <- read.ods(x)[[1]]
colnames(df) <- df[1,]
df <- df[-1,]
col <- seq(from = 1, to = ncol(df), by = 1)
err <- 0
for(i in col){
for(j in seq(from = 1, to = nrow(df), by = 1)){
if(is.na(df[j,i]) | is.null(df[j,i])) {
} else {
if(suppressWarnings(is.na(as.numeric(as.character(df[j,i]))))) {
err <- 1
} else {
}
}
}
}
if(err == 0){
df <- as.matrix(as.data.frame(lapply(df, as.numeric)))
} else {
}
}
return(df)
}
##################################################################################################
# Name: geneR
# function: gener randomly a vector of character string all differents from each other
# input : choice = the constituants of the character string (here letters), lengthComb = length of the character string, NBComb = number of needed combinations, toAvoid = combinaison to avoid
##################################################################################################
geneR <- function(choice, lengthComb, NBComb, toAvoid = NA){
if(is.null(toAvoid)){
toAvoid = NA
}
temp <- vector()
nombreMax = length(choice)^lengthComb
if(NBComb > nombreMax | (NBComb + length(toAvoid)) > nombreMax){
tkmessageBox(message = "Saturated memory. Please re-launch elementR.", icon = "error", type = "ok")
stop()
} else {
while(length(temp) != NBComb){
nom <- paste(sample(choice, lengthComb, replace = TRUE), collapse = "")
if(length(grep(nom, temp)) != 0 | length(grep(nom, toAvoid)) !=0){
} else {
temp <- c(temp, nom)
}
}
return(temp)
}
}
##################################################################################################
# Name: dir.exists (from https://github.com/hadley/staticdocs/issues/33)
# function: check if a directory exists
# input : d: directory to test
##################################################################################################
dir.exists <- function(d) {
de <- file.info(d)$isdir
ifelse(is.na(de), FALSE, de)
}
######################
################### UI
######################
sidebar <- dashboardSidebar(
useShinyjs(),
sidebarMenu(id = "tab",
div(style = "background: rgb(60, 141, 188); height: 50px",
p(icon("star-half-o"),"element-R",
style = "font-size: 200%; padding-left:50px;padding-top:5px")),
menuItem("Project setup", tabName = "start",
icon = icon("thermometer-0", class=menuIconClass),
badgeLabel="Step 1", badgeColor="blue"),
div(align="center",icon("arrow-down",class="fa-2x")),
menuItem("Reduce standards", tabName = "Standards",
icon = icon("thermometer-1", class=menuIconClass),
badgeLabel="Step 2", badgeColor="green"),
uiOutput("renderProgress2"),
div(align="center",icon("arrow-down",class="fa-2x")),
menuItem("Drift verification", tabName = "MachDrift",
icon = icon("thermometer-2", class=menuIconClass),
badgeLabel="Step 3", badgeColor="purple"),
div(align="center",icon("arrow-down",class="fa-2x")),
menuItem("Reduce samples", tabName = "Samples",
icon = icon("thermometer-3", class=menuIconClass),
badgeLabel="Step 4", badgeColor="maroon"),
uiOutput("renderProgress4"),
div(align="center",icon("arrow-down",class="fa-2x")),
menuItem("Average samples", tabName = "realign",
icon = icon("thermometer-4", class=menuIconClass),
badgeLabel="Optional", badgeColor="orange"),
uiOutput("renderProgress5"),
hr(style ="width: 70%; color: white; align: center"),
menuItem("Settings", icon = icon("sliders"), tabName = "Config"),
menuItem("Precision and accuracy", icon = icon("sliders"), tabName = "SessionConfig"),
menuItem("Source code for app", icon = icon("file-code-o"),
href = "https://github.com/charlottesirot/elementR"
),
div(uiOutput("Export"), style = "text-align: center")
)
)
body <- dashboardBody(
includeCSS(system.file("www/elementR.css", package="elementR")),
div(style = "min-height:100vh; min-width: (100vw - 230); display:flex",
div(style = "background-color: #666666; width: 31px;",
div(style = "background-color: #666666; width: 30px;position:fixed",
div(style = "background: rgb(60, 141, 188); height: 50px"),
uiOutput('ValidFlag1'),
div(style = "background-color: #666666; height: 30px; width: 30px"),
uiOutput('ValidFlag2'),
div(style = "background-color: #666666; height: 30px; width: 30px"),
uiOutput('ValidFlag3'),
div(style = "background-color: #666666; height: 30px; width: 30px"),
uiOutput('ValidFlag4'),
div(style = "background-color: #666666; height: 30px; width: 30px"),
uiOutput('ValidFlag5')
)
),
div(style = "width: 100%; margin-top:10px; margin-left:10px;margin-bottom:10px;margin-right:0px;",
uiOutput("TopBar"),
tabItems(
tabItem("start",
uiOutput("start1"),
fluidRow(
uiOutput("start2")
)
), #eo tab start
tabItem("Standards", style = "padding-right: 0px; padding-left: 0px",
uiOutput("Standards1"),
uiOutput("Standards2")
), #eo tab Standards
tabItem("MachDrift", style = "padding-right: 0px; padding-left: 0px",
uiOutput("MachDrift1"),
uiOutput("MachDrift2"),
uiOutput('MachDrift3')
), #eo tab MachDrift
tabItem("Samples", style = "padding-right: 0px; padding-left: 0px",
box(width = 12,background = "aqua", style = "background-color: #85735D;margin-bottom:10px",
column(5,
uiOutput("sample1")
),
column(2,
uiOutput("sample2")
),
column(3,
uiOutput("sample3")
),
column(1, class = "class2",
br(),
uiOutput("sample4")
)
),
column(12,
uiOutput("Sample5"))
), #eo tab Samples
tabItem("realign",
uiOutput("realign1"),
uiOutput("realign2"),
uiOutput("realign8"),
uiOutput("realign10"),
fluidRow(
column(3, uiOutput("realign3")),
column(9, uiOutput("realign5"))
)
), #eo tab realign
tabItem("Config",
uiOutput("config0"),
uiOutput("config4"),
uiOutput("config2"),
uiOutput("config3"),
uiOutput("config1")
), #eo tab Config
tabItem("SessionConfig",
uiOutput("Precision1"),
uiOutput("Precision4")
) #eo tab Config
)
)
)
)#dashboardBody
header <- dashboardHeader(
title = list(icon("star-half-o"),"element-R"), disable = TRUE, titleWidth = 260
)
ui <- dashboardPage(header, sidebar, body, skin = skin)
server <- function(input, output, session) {
currentPage <- reactiveValues(temp = c("start", "start")) #marker of the current step
observe({
if(flagStart$temp[1] != 3 & flagStart$temp[2] != 3){
if(input$tab == "Standards" | input$tab == "MachDrift" | input$tab == "Samples" | input$tab == "realign"){
updateTabItems(session, "tab", selected = "start")
Message <- "You need to finish the first step for handling the rest of the filtration procedure!"
tkmessageBox(message = Message, icon = "error", type = "ok")
}
} else if(length(which(currentProject()$flag_stand != 1)) != 0){
if(input$tab == "MachDrift" | input$tab == "Samples" | input$tab == "realign"){
updateTabItems(session, "tab", selected = "Standards")
Message <- "You need to finish reducing standards for continuing the filtration procedure!"
tkmessageBox(message = Message, icon = "error", type = "ok")
}
} else if(currentProject()$flagMachineCorrection != 1){
if(input$tab == "Samples" | input$tab == "realign"){
updateTabItems(session, "tab", selected = "MachDrift")
Message <- "You need to validate machine drift for continuing the filtration procedure!"
tkmessageBox(message = Message, icon = "error", type = "ok")
}
} else if(length(which(flagSample$temp == TRUE)) == 0){
if(input$tab == "realign"){
updateTabItems(session, "tab", selected = "Samples")
Message <- "You need to validate all the sample replicate to access the last step !"
tkmessageBox(message = Message, icon = "error", type = "ok")
}
}
})
# How to come back to the current page
observe({
currentPage$temp <- c(input$tab, isolate(currentPage$temp)[1])
})
#go to next step
observe({
if(!is.null(input$nextStep)){
if(input$nextStep > 0){
isolate({
if(input$tab == "start"){
updateTabItems(session, "tab", selected = "Standards")
} else if(input$tab == "Standards"){
updateTabItems(session, "tab", selected = "MachDrift")
} else if(input$tab == "MachDrift"){
updateTabItems(session, "tab", selected = "Samples")
} else if(input$tab == "Samples"){
updateTabItems(session, "tab", selected = "realign")
}
})
}
}
})
# go to previous step
observe({
if(!is.null(input$prevStep)){
if(input$prevStep > 0){
isolate({
if(input$tab == "realign"){
updateTabItems(session, "tab", selected = "Samples")
} else if(input$tab == "Standards"){
updateTabItems(session, "tab", selected = "start")
} else if(input$tab == "MachDrift"){
updateTabItems(session, "tab", selected = "Standards")
} else if(input$tab == "Samples"){
updateTabItems(session, "tab", selected = "MachDrift")
}
})
}
}
})
#define top bar
output$TopBar <- renderUI({
input$saveNists
input$SuppDonne
input$saveSample
input$validDrift
input$SauvegarderSpot
input$SauvegarderReal
if(is.null(currentProject())){
div(style = "background: rgb(60, 141, 188); height: 50px; margin-top:-10px; margin-left: -10px; ")
} else{
if(input$tab == "start"){
if(flagStart$temp[1] == 3 | flagStart$temp[2] == 3){
div(style = "background: rgb(60, 141, 188); height: 50px; margin-top:-10px; margin-left: -10px; ",
div(style = "overflow: auto;",
div(style ="float: right;padding-right: 20px",
actionButton("nextStep", p(icon("arrow-circle-right"), "Next Step", style="margin-bottom:5px"),
style="padding-top: 5px;padding-bottom: 0px;margin-top: 7px")
)
)
)
} else{
div(style = "background: rgb(60, 141, 188); height: 50px; margin-top:-10px; margin-left: -10px; ")
}
}
else if(input$tab == "Standards"){
if(length(which(currentProject()$flag_stand != 1)) == 0){
div(style = "background: rgb(60, 141, 188); height: 50px; margin-top:-10px; margin-left: -10px; ",
div(style = "overflow: auto;",
div(style ="float: left;padding-left: 20px",
actionButton("prevStep", p(icon("arrow-circle-left"), "Previous Step", style="margin-bottom:5px"),
style="padding-top: 5px;padding-bottom: 0px;margin-top: 7px")),
div(style ="float: right;padding-right: 20px",
actionButton("nextStep", p(icon("arrow-circle-right"), "Next Step", style="margin-bottom:5px"),
style="padding-top: 5px;padding-bottom: 0px;margin-top: 7px"))
))
} else{
div(style = "background: rgb(60, 141, 188); height: 50px; margin-top:-10px; margin-left: -10px; ",
div(style = "overflow: auto;",
div(actionButton("prevStep", p(icon("arrow-circle-left"), "Previous Step", style="margin-bottom:5px"),
style="padding-top: 5px;padding-bottom: 0px;margin-top: 7px"),
style ="float: left;padding-left: 20px")
)
)
}
}
else if(input$tab == "MachDrift"){
if((validCorrection$temp%%2) == 1){
div(style = "background: rgb(60, 141, 188); height: 50px; margin-top:-10px; margin-left: -10px; ",
div(style = "overflow: auto;",
div(actionButton("prevStep", p(icon("arrow-circle-left"), "Previous Step",
style="margin-bottom:5px"),
style="padding-top: 5px;padding-bottom: 0px;margin-top: 7px"),
style ="float: left;padding-left: 20px"),
div(actionButton("nextStep", p(icon("arrow-circle-right"), "Next Step",
style="margin-bottom:5px"),
style="padding-top: 5px;padding-bottom: 0px;margin-top: 7px"),
style ="float: right;padding-right: 20px")
)
)
} else{
div(style = "background: rgb(60, 141, 188); height: 50px; margin-top:-10px; margin-left: -10px; ",
div(style = "overflow: auto;",
div(actionButton("prevStep", p(icon("arrow-circle-left"), "Previous Step",
style="margin-bottom:5px"),
style="padding-top: 5px;padding-bottom: 0px;margin-top: 7px"),
style ="float: left;padding-left: 20px")
)
)
}
}
else if(input$tab == "Samples"){
temp <- vapply(seq(from = 1, to = length(currentProject()$flag_Sample), by = 1),
function(x){
if(sum(currentProject()$flag_Sample[[x]]) == length(currentProject()$flag_Sample[[x]])){
return(1)
}else{return(0)}
},
FUN.VALUE = numeric(1)
)
if(length(temp) == 0){
div(style = "background: rgb(60, 141, 188); height: 50px; margin-top:-10px; margin-left: -10px; ",
div(style = "overflow: auto;",
div(actionButton("prevStep", p(icon("arrow-circle-left"), "Previous Step",
style="margin-bottom:5px"),
style="padding-top: 5px;padding-bottom: 0px;margin-top: 7px"),
style ="float: left;padding-left: 20px")
)
)
} else{
div(style = "background: rgb(60, 141, 188); height: 50px; margin-top:-10px; margin-left: -10px; ",
div(style = "overflow: auto;",
div(actionButton("prevStep", p(icon("arrow-circle-left"), "Previous Step",
style="margin-bottom:5px"), style="padding-top: 5px;padding-bottom: 0px;margin-top: 7px"),
style ="float: left;padding-left: 20px"),
div(actionButton("nextStep", p(icon("arrow-circle-right"), "Next Step",
style="margin-bottom:5px"),
style="padding-top: 5px;padding-bottom: 0px;margin-top: 7px"),
style ="float: right;padding-right: 20px")
)
)
}
}
else if(input$tab == "realign"){
div(style = "background: rgb(60, 141, 188); height: 50px; margin-top:-10px; margin-left: -10px; ",
div(style = "overflow: auto;",
div(actionButton("prevStep", p(icon("arrow-circle-left"), "Previous Step",
style="margin-bottom:5px"),
style="padding-top: 5px;padding-bottom: 0px;margin-top: 7px"),
style ="float: left;padding-left: 20px")
)
)
} else{ div(style = "background: rgb(60, 141, 188); height: 50px; margin-top:-10px; margin-left: -10px; ") }
}
})
#####################################
#####################################
########### elementR formatting ####
#####################################
#####################################
{
##################
output$myImageProgressBar1 <- renderImage({
if(flagStart$temp[1] == 3 | flagStart$temp[2] == 3){
list(src = system.file("www/2.png", package="elementR"),
contentType = 'image/png',
width = 15,
height = 15,
alt = "This is alternate text")
} else {
list(src = system.file("www/3.png", package="elementR"),
contentType = 'image/png',
width = 15,
height = 15,
alt = "This is alternate text")
}
}, deleteFile = FALSE ) # eo output$myImageProgressBar1
output$ValidFlag1 <- renderUI({
if(input$tab == "start"){
div(imageOutput("myImageProgressBar1"),style = "height: 44px; width: 30px; padding-top: 8px", class = "barActive")
} else {
div(imageOutput("myImageProgressBar1"),style = "height: 44px; width: 30px; padding-top: 8px", class = "bar")
}
}) #eo output$ValidFlag1
##################
output$renderProgress2 <- renderUI({
input$saveNists
input$SuppDonne
flagStandard$temp
if(flagStart$temp[1] == 0 & flagStart$temp[2] == 0){
if(input$tab == "Standards"){
div(class = "progress",
p("Waiting for data", style = "line-height:1px; text-align:center")
)
} else {
div(class = "progressActive",
p("Waiting for data", style = "line-height:1px; text-align:center")
)
}
}
else{
if(input$tab == "Standards"){
div(class = "progress", style = "overflow: auto;",
p(paste0("Standard(s) reduced: ", sum(currentProject()$flag_stand), " / ",
length(currentProject()$flag_stand)), style = "line-height:1px; text-align:center")
)
} else {
div(class = "progressActive", style = "overflow: auto;",
p(paste0("Standard(s) reduced: ", sum(currentProject()$flag_stand), " / ",
length(currentProject()$flag_stand)), style = "line-height:1px; text-align:center")
)
}
}
}) #eo output$renderProgress2
output$myImageProgressBar2 <- renderImage({
input$saveNists
input$SuppDonne
flagStandard$temp
if(flagStart$temp[1] == 0 & flagStart$temp[2] == 0){
list(src = system.file("www/3.png", package="elementR"),
contentType = 'image/png',
width = 15,
height = 15,
alt = "This is alternate text")
} else if(length(which(currentProject()$flag_stand != 1)) == 0){
list(src = system.file("www/2.png", package="elementR"),
contentType = 'image/png',
width = 15,
height = 15,
alt = "This is alternate text")
} else {
list(src = system.file("www/3.png", package="elementR"),
contentType = 'image/png',
width = 15,
height = 15,
alt = "This is alternate text")
}
}, deleteFile = FALSE ) #eo output$myImageProgressBar2
output$ValidFlag2 <- renderUI({
if(input$tab == "Standards"){
div(
div(imageOutput("myImageProgressBar2"), style = "height: 44px; width: 30px; padding-top: 8px", class = "barActive"),
div(style = "width: 30px;", class = "barActive")
)
} else {
div(
div(imageOutput("myImageProgressBar2"),style = "height: 44px; width: 30px; padding-top: 8px", class = "bar"),
div(style = "width: 30px;", class = "bar")
)
}
}) #eo output$ValidFlag2
#############
output$myImageProgressBar3 <- renderImage({
input$saveNists
input$SuppDonne
input$saveSample
input$validDrift
if(flagStart$temp[1] == 0 & flagStart$temp[2] == 0){
list(src = system.file("www/3.png", package="elementR"),
contentType = 'image/png',
width = 15,
height = 15,
alt = "This is alternate text")
} else if(is.null(validCorrection$temp)){
list(src = system.file("www/3.png", package="elementR"),
contentType = 'image/png',
width = 15,
height = 15,
alt = "This is alternate text")
} else if((validCorrection$temp%%2) == 1){
list(src = system.file("www/2.png", package="elementR"),
contentType = 'image/png',
width = 15,
height = 15,
alt = "This is alternate text")
} else{
list(src = system.file("www/3.png", package="elementR"),
contentType = 'image/png',
width = 15,
height = 15,
alt = "This is alternate text")
}
}, deleteFile = FALSE ) #eo output$myImageProgressBar3
output$ValidFlag3 <- renderUI({
if(input$tab == "MachDrift"){
div(imageOutput("myImageProgressBar3"),style = "height: 44px; width: 30px; padding-top: 8px", class = "barActive")
} else {
div(imageOutput("myImageProgressBar3"),style = "height: 44px; width: 30px; padding-top: 8px", class = "bar")
}
}) #eo output$ValidFlag3
#############
output$renderProgress4 <- renderUI({
input$saveNists
input$SuppDonne
input$saveSample
input$validDrift
if(flagStart$temp[1] == 0 & flagStart$temp[2] == 0){
if(input$tab == "Samples"){
div(class = "progress",
p("Waiting for data", style = "line-height:1px; text-align:center")
)
} else {
div(class = "progressActive",
p("Waiting for data", style = "line-height:1px; text-align:center")
)
}
} else if(input$tab == "Samples"){
if(!is.null(currentProject()$flag_Sample)){
div(class = "progress", style = "overflow: auto;",
p(paste0("Sample repl. reduced: ", do.call(sum, currentProject()$flag_Sample), " / ",
length(unlist(currentProject()$flag_Sample))), style = "line-height:1px; text-align:center")
)
}
} else {
if(!is.null(currentProject()$flag_Sample)){
div(class = "progressActive", style = "overflow: auto;",
p(paste0("Sample repl. reduced: ", do.call(sum, currentProject()$flag_Sample), " / ",
length(unlist(currentProject()$flag_Sample))), style = "line-height:1px; text-align:center")
)
}
}
}) #eo output$renderProgress4
output$myImageProgressBar4 <- renderImage({
input$saveNists
input$SuppDonne
input$saveSample
input$validDrift
input$SauvegarderSpot
input$SauvegarderReal
if(flagStart$temp[1] == 0 & flagStart$temp[2] == 0){
list(src = system.file("www/3.png", package="elementR"),
contentType = 'image/png',
width = 15,
height = 15,
alt = "This is alternate text")
} else{
temp <- vapply(seq(from = 1, to = length(currentProject()$flag_Sample), by = 1),
function(x){
if(sum(currentProject()$flag_Sample[[x]]) == length(currentProject()$flag_Sample[[x]])){
return(1)
}else{return(0)}
},
FUN.VALUE = numeric(1)
)
if(length(temp) == 0){
list(src = system.file("www/3.png", package="elementR"),
contentType = 'image/png',
width = 15,
height = 15,
alt = "This is alternate text")
} else if(length(which(temp == 0)) != 0){
list(src = system.file("www/3.png", package="elementR"),
contentType = 'image/png',
width = 15,
height = 15,
alt = "This is alternate text")
} else {
list(src = system.file("www/2.png", package="elementR"),
contentType = 'image/png',
width = 15,
height = 15,
alt = "This is alternate text")
}
}
}, deleteFile = FALSE ) #eo output$myImageProgressBar4
output$ValidFlag4 <- renderUI({
if(input$tab == "Samples"){
div(
div(imageOutput("myImageProgressBar4"), style = "height: 44px; width: 30px; padding-top: 8px", class = "barActive"),
div(style = "width: 30px;", class = "barActive")
)
} else {
div(
div(imageOutput("myImageProgressBar4"),style = "height: 44px; width: 30px; padding-top: 8px", class = "bar"),
div(style = "width: 30px;", class = "bar")
)
}
}) #eo output$ValidFlag4
#############
output$renderProgress5 <- renderUI({
input$saveNists
input$SuppDonne
input$saveSample
input$validDrift
input$SauvegarderSpot
input$SauvegarderReal
if(flagStart$temp[1] == 0 & flagStart$temp[2] == 0){
if(input$tab == "realign"){
div(class = "progress",
p("Waiting for data", style = "line-height:1px; text-align:center")
)
} else {
div(class = "progressActive",
p("Waiting for data", style = "line-height:1px; text-align:center")
)
}
} else{
if(input$tab == "realign"){
temp <- sum(vapply(seq(from = 1, to = length(flagRealign$temp), by = 1),
function(x){
if(flagRealign$temp[[x]][1] == 1 | flagRealign$temp[[x]][2] == 3){
return(1)
} else{return(0)}
},
FUN.VALUE = numeric(1)
)
)
div(class = "progress", style = "overflow: auto;",
p(paste0("Samples handled: ", temp, " / ", length(flagRealign$temp)),
style = "line-height:1px; text-align:center")
)
} else{
if(is.null(flagRealign$temp)){
temp <- 0
} else {
temp <- sum(vapply(seq(from = 1, to = length(flagRealign$temp), by = 1),
function(x){
if(flagRealign$temp[[x]][1] == 1 | flagRealign$temp[[x]][2] == 3){
return(1)
} else{return(0)}
},
FUN.VALUE = numeric(1)
)
)
}
div(class = "progressActive", style = "overflow: auto;",
p(paste0("Samples handled: ", temp, " / ", length(flagRealign$temp)), style = "line-height:1px; text-align:center")
)
}
}
}) #eo output$renderProgress5
output$myImageProgressBar5 <- renderImage({
input$saveNists
input$SuppDonne
input$saveSample
input$validDrift
input$SauvegarderSpot
input$SauvegarderReal
if(flagStart$temp[1] == 0 & flagStart$temp[2] == 0){
list(src = system.file("www/3.png", package="elementR"),
contentType = 'image/png',
width = 15,
height = 15,
alt = "This is alternate text")
} else if(is.null(flagRealign$temp)){
list(src = system.file("www/3.png", package="elementR"),
contentType = 'image/png',
width = 15,
height = 15,
alt = "This is alternate text")
}else{
temp <- vapply(seq(from = 1, to = length(flagRealign$temp), by = 1),
function(x){
if(flagRealign$temp[[x]][1] == 1 | flagRealign$temp[[x]][2] == 3){
return(1)
} else{return(0)}
},
FUN.VALUE = numeric(1)
)
if(length(which(temp == 0)) == 0){
list(src = system.file("www/2.png", package="elementR"),
contentType = 'image/png',
width = 15,
height = 15,
alt = "This is alternate text")
} else{
list(src = system.file("www/3.png", package="elementR"),
contentType = 'image/png',
width = 15,
height = 15,
alt = "This is alternate text")
}
}
}, deleteFile = FALSE) #eo output$myImageProgressBar5
output$ValidFlag5 <- renderUI({
if(input$tab == "realign"){
div(
div(imageOutput("myImageProgressBar5"),style = "height: 44px; width: 30px; padding-top: 8px", class = "barActive"),
div(style = "width: 30px;", class = "barActive")
)
}else{
div(
div(imageOutput("myImageProgressBar5"),style = "height: 44px; width: 30px; padding-top: 8px", class = "bar"),
div(style = "width: 30px;", class = "bar")
)
}
}) #eo output$ValidFlag5
}
#################################
#################################
########### Project Export ####
#################################
#################################
{
#############################################
# define output$Export, i.e. the div allowing
# to rename the project and to export it
#############################################
observe({
if(flagStart$temp[1] == 3 | flagStart$temp[2] == 3){
output$Export <- renderUI({
div(
textInput("text", label = "", value = "Name of your project..."),
actionButton("export","Export Project")
)
})
}else{
output$Export <- renderUI({NULL})
}
}) #observe
#############################################
# Export the data
#############################################
observe({
if(!is.null(input$export)){
if(input$export > 0){
isolate({
espace1 <- getwd()
setwd(paste0(projPath$temp,"/Results"))
pb <- tkProgressBar("Progress bar", "Project export in %",
0, 100, 0)
myProject <- currentProject()
temp <- str_split(projPath$temp, "/")[[1]]
nameToInsert <- temp[length(temp)]
if(input$text == "Name of your project..."){
if(flagStart$temp[2] == 3){
if(WhatLoaded$temp == "notExample"){
save(myProject, file = paste0(nameToInsert, ".RData"))
} else {
save(myProject, file = "Example_Session.RData")
}
} else {
save(myProject, file = paste0(nameToInsert, ".RData"))
}
} else {
save(myProject, file = paste0(input$text, ".RData"))
}
if(!is.null(input$exportseptData)){
if(input$exportseptData == "Tab key"){
sep <- "\t"
} else if(input$exportseptData == "Blank"){
sep <- " "
} else{sep <- input$exportseptData}
}
if(currentProject()$flagMachineCorrection == 1){
tempo <- currentProject()$regressionModel
if(is.null(input$exportFormatData)){
write.csv(tempo, file = "regression_parameters.csv")
} else if(input$exportFormatData == ".csv"){
write.table(tempo, file = "regression_parameters.csv", sep = sep)
} else{
write.table(as.data.frame(tempo), file = paste0("regression_parameters", input$exportFormatData), sep = sep)
}
if(is.null(input$exportFormatData)){
write.csv(currentProject()$standards[[1]]$rep_dataFinale, file = "SummaryStandard.csv")
} else{
if(input$exportFormatData == ".csv"){
write.table(currentProject()$standards[[1]]$rep_dataFinale, file = "SummaryStandard.csv", sep = sep)
}
else{
write.table(as.data.frame(currentProject()$standards[[1]]$rep_dataFinale),
file = paste0("SummaryStandard",input$exportFormatData), sep = sep)
}
}
} else {
invisible(file.remove(list.files(,pattern = "Drift")))
invisible(file.remove(list.files(,pattern = "regression_parameters")))
invisible(file.remove(list.files(,pattern = "SummaryStandard")))
invisible(file.remove(list.files(,pattern = "PrecisionTable")))
invisible(file.remove(list.files(,pattern = "CorrectnessTable")))
}
if(is.matrix(currentProject()$summarySettings)){
if(is.null(input$exportFormatData)){
write.csv(currentProject()$summarySettings, file = "SummarySettings.csv")
} else{
if(input$exportFormatData == ".csv"){
write.table(currentProject()$summarySettings, file = "SummarySettings.csv", sep = sep)
}
else{
write.table(as.data.frame(currentProject()$summarySettings), file = paste0("SummarySettings",input$exportFormatData), sep = sep)
}
}
}
if(is.matrix(currentProject()$precisionTable)){
if(is.null(input$exportFormatData)){
write.csv(currentProject()$precisionTable, file = "PrecisionTable.csv")
} else{
if(input$exportFormatData == ".csv"){
write.table(currentProject()$precisionTable, file = "PrecisionTable.csv", sep = sep)
}
else{
write.table(as.data.frame(currentProject()$precisionTable), file = paste0("PrecisionTable",input$exportFormatData), sep = sep)
}
}
}
if(is.matrix(currentProject()$correctnessTable) | is.data.frame(currentProject()$correctnessTable)){
if(is.null(input$exportFormatData)){
write.csv(currentProject()$correctnessTable, file = "CorrectnessTable.csv")
} else{
if(input$exportFormatData == ".csv"){
write.table(currentProject()$correctnessTable, file = "CorrectnessTable.csv", sep = sep)
}
else{
write.table(as.data.frame(currentProject()$correctnessTable), file = paste0("CorrectnessTable",input$exportFormatData), sep = sep)
}
}
}
info <- sprintf("%d%% done", round(20))
setTkProgressBar(pb, 20, sprintf("Export (%s)", info), info)
setwd(espace1)
setwd(paste0(projPath$temp,"/Results/standards"))
lapply(seq(from = 1, to = length(currentProject()$standards[[1]]$rep_Files), by = 1), function(x){
suppressWarnings(dir.create(paste0(projPath$temp,"/Results/standards/", currentProject()$standards[[1]]$rep_Files[x])))
})
lapply(seq(from = 1, to = length(currentProject()$standards[[1]]$rep_Files), by = 1),function(x){
setwd(paste0(projPath$temp,"/Results/standards/", currentProject()$standards[[1]]$rep_Files[x]))
info <- sprintf("%d%% done", round(20 + x*10/length(currentProject()$standards[[1]]$rep_Files)))
setTkProgressBar(pb, round(20 + x*10/length(currentProject()$standards[[1]]$rep_Files)), sprintf("Export (%s)", info), info)
if(currentProject()$flag_stand[x] == 0){
ToRemove <- list.files(, pattern = ".csv")
invisible(file.remove(ToRemove))
ToRemove <- list.files(, pattern = ".xls")
invisible(file.remove(ToRemove))
ToRemove <- list.files(, pattern = ".jpg", recursive = TRUE)
invisible(file.remove(ToRemove))
ToRemove <- list.files(, pattern = ".jpeg", recursive = TRUE)
invisible(file.remove(ToRemove))
ToRemove <- list.files(, pattern = ".bmp", recursive = TRUE)
invisible(file.remove(ToRemove))
ToRemove <- list.files(, pattern = ".png", recursive = TRUE)
invisible(file.remove(ToRemove))
ToRemove <- list.files(, pattern = ".tiff", recursive = TRUE)
invisible(file.remove(ToRemove))
}
if(currentProject()$flag_stand[x] != 0){
dat <- currentProject()$standards[[1]]$rep_data[[x]]
if(is.null(input$exportFormatData)){
write.csv(dat$dataBlank, file = paste0("data_Blank_",currentProject()$standards[[1]]$rep_Files[x],".csv"))
write.csv(dat$dataPlateau, file = paste0("data_Plateau_",currentProject()$standards[[1]]$rep_Files[x],".csv"))
write.csv(dat$dataSuppBlank, file = paste0("data_SuppBlank_",currentProject()$standards[[1]]$rep_Files[x],".csv"))
write.csv(dat$dataSupLOD, file = paste0("data_SupLOD_",currentProject()$standards[[1]]$rep_Files[x],".csv"))
write.csv(dat$dataNorm, file = paste0("data_Norm_",currentProject()$standards[[1]]$rep_Files[x],".csv"))
write.csv(dat$dataOutlierFree, file = paste0("data_OutlierFree_",currentProject()$standards[[1]]$rep_Files[x],".csv"))
} else if(input$exportFormatData == ".csv"){
write.table(dat$dataBlank, file = paste0("data_Blank_",currentProject()$standards[[1]]$rep_Files[x],".csv"), sep = sep)
write.table(dat$dataPlateau, file = paste0("data_Plateau_",currentProject()$standards[[1]]$rep_Files[x],".csv"), sep = sep)
write.table(dat$dataSuppBlank, file = paste0("data_SuppBlank_",currentProject()$standards[[1]]$rep_Files[x],".csv"), sep = sep)
write.table(dat$dataSupLOD, file = paste0("data_SupLOD_",currentProject()$standards[[1]]$rep_Files[x],".csv"), sep = sep)
write.table(dat$dataNorm, file = paste0("data_Norm_",currentProject()$standards[[1]]$rep_Files[x],".csv"), sep = sep)
write.table(dat$dataOutlierFree, file = paste0("data_OutlierFree_",currentProject()$standards[[1]]$rep_Files[x],".csv"), sep = sep)
} else {
format <- input$exportFormatData
write.table(as.data.frame(dat$dataBlank), file = paste0("data_Blank_",currentProject()$standards[[1]]$rep_Files[x],format), sep = sep)
write.table(as.data.frame(dat$dataPlateau), file = paste0("data_Plateau_",currentProject()$standards[[1]]$rep_Files[x],format), sep = sep)
write.table(as.data.frame(dat$dataSuppBlank), file = paste0("data_SuppBlank_",currentProject()$standards[[1]]$rep_Files[x],format), sep = sep)
write.table(as.data.frame(dat$dataSupLOD), file = paste0("data_SupLOD_",currentProject()$standards[[1]]$rep_Files[x],format), sep = sep)
write.table(as.data.frame(dat$dataNorm), file = paste0("data_Norm_",currentProject()$standards[[1]]$rep_Files[x],format), sep = sep)
write.table(as.data.frame(dat$dataOutlierFree), file = paste0("data_OutlierFree_",currentProject()$standards[[1]]$rep_Files[x],format), sep = sep)
}
}
}) # eo lapply
lapply(seq(from = 1, to = length(currentProject()$samplesFiles), by = 1), function(x){
setwd(espace1)
suppressWarnings(dir.create(paste0(projPath$temp,"/Results/samples/",currentProject()$samplesFiles[x])))
lapply(seq(from = 1, to = length(currentProject()$samples[[x]]$rep_Files), by = 1), function(y){
setwd(espace1)
info <- sprintf("%d%% done", round(30 + (x*70/length(currentProject()$samplesFiles))*y/length(currentProject()$samples[[x]]$rep_Files)))
setTkProgressBar(pb, round(30 + (x*70/length(currentProject()$samplesFiles))*y/length(currentProject()$samples[[x]]$rep_Files)),
sprintf("Export (%s)", info), info)
temporaire <- currentProject()$samples[[x]]$rep_Files[y]
suppressWarnings(dir.create(paste0(projPath$temp,"/Results/samples/",currentProject()$samplesFiles[x],"/",temporaire)))
setwd(paste0(projPath$temp,"/Results/samples/",currentProject()$samplesFiles[x],"/",temporaire))
if(currentProject()$flag_Sample[[x]][y] == 0){
ToRemove <- list.files(, pattern = ".csv")
invisible(file.remove(ToRemove))
ToRemove <- list.files(, pattern = ".xls")
invisible(file.remove(ToRemove))
ToRemove <- list.files(, pattern = ".jpg", recursive = TRUE)
invisible(file.remove(ToRemove))
ToRemove <- list.files(, pattern = ".jpeg", recursive = TRUE)
invisible(file.remove(ToRemove))
ToRemove <- list.files(, pattern = ".bmp", recursive = TRUE)
invisible(file.remove(ToRemove))
ToRemove <- list.files(, pattern = ".png", recursive = TRUE)
invisible(file.remove(ToRemove))
ToRemove <- list.files(, pattern = ".tiff", recursive = TRUE)
invisible(file.remove(ToRemove))
}
if(currentProject()$flag_Sample[[x]][y] != 0){
dat <- currentProject()$samples[[x]]$rep_data[[y]]
if(is.null(input$exportFormatData)){
write.csv(dat$dataBlank, file = paste0("data_Blank_",temporaire,".csv"))
write.csv(dat$dataPlateau, file = paste0("data_Plateau_",temporaire,".csv"))
write.csv(dat$dataSuppBlank, file = paste0("data_SuppBlank_",temporaire,".csv"))
write.csv(dat$dataSupLOD, file = paste0("data_SupLOD_",temporaire,".csv"))
write.csv(dat$dataNorm, file = paste0("data_Norm_",temporaire,".csv"))
write.csv(dat$dataConc, file = paste0("data_Conc_",temporaire,".csv"))
write.csv(dat$dataConcCorr, file = paste0("data_ConcCorr_",temporaire,".csv"))
} else if(input$exportFormatData == ".csv"){
write.table(dat$dataBlank, file = paste0("data_Blank_",temporaire,".csv"), sep = sep)
write.table(dat$dataPlateau, file = paste0("data_Plateau_",temporaire,".csv"), sep = sep)
write.table(dat$dataSuppBlank, file = paste0("data_SuppBlank_",temporaire,".csv"), sep = sep)
write.table(dat$dataSupLOD, file = paste0("data_SupLOD_",temporaire,".csv"), sep = sep)
write.table(dat$dataNorm, file = paste0("data_Norm_",temporaire,".csv"), sep = sep)
write.table(dat$dataConc, file = paste0("data_Conc_",temporaire,".csv"), sep = sep)
write.table(dat$dataConcCorr, file = paste0("data_ConcCorr_",temporaire,".csv"), sep = sep)
} else {
write.table(as.data.frame(dat$dataBlank), file = paste0("data_Blank_",temporaire,input$exportFormatData), sep = sep)
write.table(as.data.frame(dat$dataPlateau), file = paste0("data_Plateau_",temporaire,input$exportFormatData), sep = sep)
write.table(as.data.frame(dat$dataSuppBlank), file = paste0("data_SuppBlank_",temporaire,input$exportFormatData), sep = sep)
write.table(as.data.frame(dat$dataSupLOD), file = paste0("data_SupLOD_",temporaire,input$exportFormatData), sep = sep)
write.table(as.data.frame(dat$dataNorm), file = paste0("data_Norm_",temporaire,input$exportFormatData), sep = sep)
write.table(as.data.frame(dat$dataConc), file = paste0("data_Conc_",temporaire,input$exportFormatData), sep = sep)
write.table(as.data.frame(dat$dataConcCorr), file = paste0("data_ConcCorr_",temporaire,input$exportFormatData), sep = sep)
}
}
}) #eo lapply
setwd(paste0(projPath$temp,"/Results/samples/",currentProject()$samplesFiles[x]))
if((flagRealign$temp[[x]][2]%%4) == 1|(flagRealign$temp[[x]][2]%%4) == 3|(flagRealign$temp[[x]][1]%%2) == 1){
if(!is.na(currentProject()$samples[[x]]$rep_type2)){
if(currentProject()$samples[[x]]$rep_type2 == "spot"){
invisible(file.remove(list.files()[which(str_detect(list.files(), "finalReplicates") == TRUE)]))
if(is.null(input$exportFormatData)){
write.csv(currentProject()$samples[[x]]$rep_dataFinalSpot, file = paste0("final_",currentProject()$samplesFiles[x],".csv"))
} else if(input$exportFormatData == ".csv"){
write.table(currentProject()$samples[[x]]$rep_dataFinalSpot, file = paste0("final_",currentProject()$samplesFiles[x],".csv"), sep = sep)
} else {
write.table(as.data.frame(currentProject()$samples[[x]]$rep_dataFinalSpot),
file = paste0("final_",currentProject()$samplesFiles[x],input$exportFormatData), sep = sep)
}
} else if(currentProject()$samples[[x]]$rep_type2 == "transect"){
if(is.null(input$exportFormatData)){
lapply(seq(from = 1, to = length(currentProject()$samples[[x]]$rep_dataIntermRaster), by = 1), function(k){
write.csv(currentProject()$samples[[x]]$rep_dataIntermRaster[[k]],
file = paste0("finalReplicates_",names(currentProject()$samples[[x]]$rep_dataIntermRaster)[k],".csv"))
})
write.csv(currentProject()$samples[[x]]$rep_dataFinalRaster,
file = paste0("final_",currentProject()$samplesFiles[x],".csv"))
write.csv(currentProject()$samples[[x]]$rep_dataFinalRasterNonCorr,
file = paste0("finalCorr_",currentProject()$samplesFiles[x],".csv"))
} else if(input$exportFormatData == ".csv"){
lapply(seq(from = 1, to = length(currentProject()$samples[[x]]$rep_dataIntermRaster), by = 1), function(k){
write.table(currentProject()$samples[[x]]$rep_dataIntermRaster[[k]],
file = paste0("finalReplicates_",names(currentProject()$samples[[x]]$rep_dataIntermRaster)[k],".csv"),
sep = sep)
})
write.table(currentProject()$samples[[x]]$rep_dataFinalRaster,
file = paste0("final_",currentProject()$samplesFiles[x],".csv"), sep = sep)
write.table(currentProject()$samples[[x]]$rep_dataFinalRasterNonCorr,
file = paste0("finalCorr_",currentProject()$samplesFiles[x],".csv"))
} else {
lapply(seq(from = 1, to = length(currentProject()$samples[[x]]$rep_dataIntermRaster), by = 1), function(k){
write.table(as.data.frame(currentProject()$samples[[x]]$rep_dataIntermRaster[[k]]),
file = paste0("finalReplicates_",names(currentProject()$samples[[x]]$rep_dataIntermRaster)[k],input$exportFormatData),
sep = sep)
})
write.table(as.data.frame(currentProject()$samples[[x]]$rep_dataFinalRaster),
file = paste0("final_",currentProject()$samplesFiles[x],input$exportFormatData), sep = sep)
write.table(as.data.frame(currentProject()$samples[[x]]$rep_dataFinalRasterNonCorr),
file = paste0("finalCorr_",currentProject()$samplesFiles[x],input$exportFormatData), sep = sep)
}
}
}
} else {
ToRemove <- list.files(, pattern = ".csv")[-match(currentProject()$samples[[x]]$rep_Files, list.files(, pattern = ".csv"))]
invisible(file.remove(ToRemove))
ToRemove <- list.files(, pattern = ".xls")[-match(currentProject()$samples[[x]]$rep_Files, list.files(, pattern = ".xls"))]
invisible(file.remove(ToRemove))
if(dir.exists(paste0(projPath$temp,"/Results/samples/",currentProject()$samplesFiles[x], "/graphics")) == TRUE){
setwd(paste0(projPath$temp,"/Results/samples/",currentProject()$samplesFiles[x], "/graphics"))
ToRemove <- list.files(, pattern = ".jpg")
invisible(file.remove(ToRemove))
ToRemove <- list.files(, pattern = ".jpeg")
invisible(file.remove(ToRemove))
ToRemove <- list.files(, pattern = ".bmp")
invisible(file.remove(ToRemove))
ToRemove <- list.files(, pattern = ".png")
invisible(file.remove(ToRemove))
ToRemove <- list.files(, pattern = ".tiff")
invisible(file.remove(ToRemove))
}
}
}) #eo lapply
info <- sprintf("%d%% done", round(100))
setTkProgressBar(pb, 100, sprintf("Export (%s)", info), info)
setwd(espace1)
close(pb)
res <- tkmessageBox(title = "INFO !",message = "Project exported", icon = "info", type = "ok")
})
}
}
}) #observe
}
#################################
#################################
########### Graphics Export ####
#################################
#################################
{
observe({
if(!is.null(input$ExportGraph)){
if(input$ExportGraph > 0){
isolate({
espace1 <- getwd()
temporaire <- input$standardIn
suppressWarnings(dir.create(paste0(projPath$temp,"/Results/standards/", temporaire, "/graphics")))
setwd(paste0(projPath$temp,"/Results/standards/", temporaire, "/graphics"))
if(!is.null(length(input$courveToExport)) & length(input$courveToExport) != 0){
if(!is.null(length(input$ElementToExport)) & length(input$ElementToExport) != 0){
pb <- tkProgressBar("Progress bar", "Graphic export in %",
0, 100, 0)
#### Raw Data exporting #####
if(is.null(input$exportFormat)){
jpeg(filename = paste0("RawData_",temporaire ,".jpg"), width = 760, height = 400)
} else {
if(input$exportFormat == ".jpeg"){
jpeg(filename = paste0("RawData_",temporaire ,".jpg"),
width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".bpm"){
bmp(filename = paste0("RawData_",temporaire ,".bmp"),
width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".png"){
png(filename = paste0("RawData_",temporaire ,".png"),
width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".tiff"){
tiff(filename = paste0("RawData_",temporaire ,".tiff"),
width = input$exportwidth, height = input$exportheight)
}
}
mat<- matrix(c(1,1,1,1,1,1,1,1,1,2),1)
layout(mat)
par(mar = c(5.1,5,4.1,1))
if(length(currentNumber$temp) != 0 & !is.null(currentNISTData$temp)){
maxY <- max(currentNISTData$temp, na.rm = TRUE)
minX <- min(currentNISTData$temp[,1], na.rm = TRUE)
maxX <- max(currentNISTData$temp[,1], na.rm = TRUE)
plot(currentNISTData$temp[,1],
currentNISTData$temp[,input$ElementToExport[1]],
type ="b", ylab = "", xlab = "", main = "", col = color$temp[which(input$ElementToExport[1] == names(color$temp))], xlim = c(minX, maxX), ylim =c(0,maxY))
mtext("Signal intensity (cps)",side=2,line=2.4, cex=1.2)
mtext("Time (s)",side=1,line=1.5, at=par("usr")[2]-0.05*diff(par("usr")[1:2]), cex=1.2)
mtext("Raw data",side=3,line=0.75, cex=1.2, font = 2)
lapply(seq(from = 1, to = length(input$ElementToExport), by = 1), function(x){
par(new = TRUE)
plot(currentNISTData$temp[,1],
currentNISTData$temp[,input$ElementToExport[x]],
type ="b", ylab = "", xlab = "", main = "", col = color$temp[which(input$ElementToExport[x] == names(color$temp))],
xlim = c(minX, maxX), ylim =c(0,maxY), axes = FALSE)
})
if((flagStandard$temp[which(as.matrix(currentProject()$standardsFiles) == input$standardIn)] %%2) == 0){
Temp$t <- currentProject()$closest(x = currentNISTData$temp[,1], y = input$bins[1])[[2]]
Temp0$t <- currentProject()$closest(x = currentNISTData$temp[,1], y = input$bins[2])[[2]]
Temp1$t <- currentProject()$closest(x = currentNISTData$temp[,1], y = input$plat[[1]])[[2]]
Temp2$t <- currentProject()$closest(x = currentNISTData$temp[,1], y = input$plat[[2]])[[2]]
} else if((flagStandard$temp[which(as.matrix(currentProject()$standardsFiles) == input$standardIn)] %%2) == 1){
Temp$t <- currentProject()$closest(x = currentNISTData$temp[,1], y = currentNISTRep$temp$bins[1])[[2]]
Temp0$t <- currentProject()$closest(x = currentNISTData$temp[,1], y = currentNISTRep$temp$bins[2])[[2]]
Temp1$t <- currentProject()$closest(x = currentNISTData$temp[,1], y = currentNISTRep$temp$plat[1])[[2]]
Temp2$t <- currentProject()$closest(x = currentNISTData$temp[,1], y = currentNISTRep$temp$plat[2])[[2]]
}
rect(currentNISTData$temp[Temp$t,1],-maxY,currentNISTData$temp[Temp0$t,1],(1+10/100)*maxY, col = "#8B735564", border = NA)
rect(currentNISTData$temp[Temp1$t,1],-maxY,currentNISTData$temp[Temp2$t,1],(1+10/100)*maxY, col ="#4F3CBC30", border = NA)
abline(v = currentNISTData$temp[Temp$t,1], lty = "dashed", col = "grey", lwd = 2)
abline(v = currentNISTData$temp[Temp0$t,1], lty = "dashed", col = "grey", lwd = 2)
abline(v = currentNISTData$temp[Temp1$t,1], lty = "dashed", col = "#4F3CBC50", lwd = 2)
abline(v = currentNISTData$temp[Temp2$t,1], lty = "dashed", col = "#4F3CBC50", lwd = 2)
lapply(input$ElementToExport, function(x){points(currentNISTData$temp[Temp$t,1], currentNISTData$temp[Temp$t,x], cex = 3, col ="grey")})
lapply(input$ElementToExport, function(x){points(currentNISTData$temp[Temp0$t,1], currentNISTData$temp[Temp0$t,x], cex = 3, col ="grey")})
lapply(input$ElementToExport, function(x){points(currentNISTData$temp[Temp1$t,1], currentNISTData$temp[Temp1$t,x], cex = 3, col ="#4F3CBC50")})
lapply(input$ElementToExport, function(x){points(currentNISTData$temp[Temp2$t,1], currentNISTData$temp[Temp2$t,x], cex = 3, col ="#4F3CBC50")})
# }
}
par(mar = c(0,0,2,1))
plot(0,0, axes = FALSE, type = "n")
legend(-1,1, legend = input$ElementToExport, bty = "n",
col = color$temp[vapply(seq(from = 1, to = length(input$ElementToExport), by = 1),
function(x) {which(input$ElementToExport[x] == names(color$temp))},
FUN.VALUE = numeric(1)
)
],
pch = 16, cex = 1.5)
dev.off()
info <- sprintf("%d%% done", round(10))
setTkProgressBar(pb, 10, sprintf("Export (%s)", info), info)
nbGraph <- floor(length(input$ElementToExport)/6)
nRest <- length(input$ElementToExport)%%6
if(nbGraph != 0){
for(i in 1: nbGraph){
if(is.null(input$exportFormat)){
jpeg(filename = paste0("RawData_All_graph",i,".jpg"), width = 760, height = 400)
} else{
if(input$exportFormat == ".jpeg"){
jpeg(filename = paste0("RawData_All_graph",i,".jpg"), width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".bmp"){
bmp(filename = paste0("RawData_All_graph",i,".bmp"), width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".png"){
png(filename = paste0("RawData_All_graph",i,".png"), width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".tiff"){
tiff(filename = paste0("RawData_All_graph",i,".tiff"), width = input$exportwidth, height = input$exportheight)
}
}
par(mfrow = c(2,3), mar = c(3,4.1,2,2), oma=c(0,0,1,0))
for(j in (6*(i-1)+1):(6*i)){
maxY <- max(currentNISTData$temp[,input$ElementToExport[j]], na.rm = TRUE)
minX <- min(currentNISTData$temp[,1], na.rm = TRUE)
maxX <- max(currentNISTData$temp[,1], na.rm = TRUE)
plot(currentNISTData$temp[,1], currentNISTData$temp[,input$ElementToExport[j]],type ="b", ylab = "", xlab = "",
main = paste0("RawData_",input$ElementToExport[j]), col = "black", xlim = c(minX, maxX), ylim =c(0,maxY))
mtext("Signal intensity (cps)",side=2,line=2.4, cex=1.2)
mtext("Time (s)",side=1,line=1.5, at=par("usr")[2]-0.05*diff(par("usr")[1:2]), cex=1.2)
if((flagStandard$temp[which(as.matrix(currentProject()$standardsFiles) == input$standardIn)] %%2) == 0){
Temp$t <- currentProject()$closest(x = currentNISTData$temp[,1], y = input$bins[1])[[2]]
Temp0$t <- currentProject()$closest(x = currentNISTData$temp[,1], y = input$bins[2])[[2]]
Temp1$t <- currentProject()$closest(x = currentNISTData$temp[,1], y = input$plat[[1]])[[2]]
Temp2$t <- currentProject()$closest(x = currentNISTData$temp[,1], y = input$plat[[2]])[[2]]
} else if((flagStandard$temp[which(as.matrix(currentProject()$standardsFiles) == input$standardIn)] %%2) == 1){
Temp$t <- currentProject()$closest(x = currentNISTData$temp[,1], y = currentNISTRep$temp$bins[1])[[2]]
Temp0$t <- currentProject()$closest(x = currentNISTData$temp[,1], y = currentNISTRep$temp$bins[2])[[2]]
Temp1$t <- currentProject()$closest(x = currentNISTData$temp[,1], y = currentNISTRep$temp$plat[1])[[2]]
Temp2$t <- currentProject()$closest(x = currentNISTData$temp[,1], y = currentNISTRep$temp$plat[2])[[2]]
}
rect(currentNISTData$temp[Temp$t,1],-maxY,
currentNISTData$temp[Temp0$t,1],(1+10/100)*maxY, col = "#8B735564", border = NA)
rect(currentNISTData$temp[Temp1$t,1],-maxY,
currentNISTData$temp[Temp2$t,1],(1+10/100)*maxY, col ="#4F3CBC30", border = NA)
abline(v = currentNISTData$temp[Temp$t,1], lty = "dashed", col = "grey", lwd = 2)
abline(v = currentNISTData$temp[Temp0$t,1], lty = "dashed", col = "grey", lwd = 2)
abline(v = currentNISTData$temp[Temp1$t,1], lty = "dashed", col = "#4F3CBC50", lwd = 2)
abline(v = currentNISTData$temp[Temp2$t,1], lty = "dashed", col = "#4F3CBC50", lwd = 2)
points(currentNISTData$temp[Temp$t,1], currentNISTData$temp[Temp$t,input$ElementToExport[j]], cex = 3, col ="grey")
points(currentNISTData$temp[Temp0$t,1], currentNISTData$temp[Temp0$t,input$ElementToExport[j]], cex = 3, col ="grey")
points(currentNISTData$temp[Temp1$t,1], currentNISTData$temp[Temp1$t,input$ElementToExport[j]], cex = 3, col ="#4F3CBC50")
points(currentNISTData$temp[Temp2$t,1], currentNISTData$temp[Temp2$t,input$ElementToExport[j]], cex = 3, col ="#4F3CBC50")
}
title(input$standardIn, outer=TRUE, cex = 1.5)
dev.off()
}
}
if(nRest != 0){
if(is.null(input$exportFormat)){
jpeg(filename = paste0("RawData_All_graph",nbGraph+1,".jpg"), width = 760, height = 400)
} else {
if(input$exportFormat == ".jpeg"){
jpeg(filename = paste0("RawData_All_graph",nbGraph+1,".jpg"), width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".bmp"){
bmp(filename = paste0("RawData_All_graph",nbGraph+1,".bmp"), width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".png"){
png(filename = paste0("RawData_All_graph",nbGraph+1,".png"), width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".tiff"){
tiff(filename = paste0("RawData_All_graph",nbGraph+1,".tiff"), width = input$exportwidth, height = input$exportheight)
}
}
par(mfrow = c(2,3), mar = c(3,4.1,2,2), oma=c(0,0,1,0))
for(j in (6*nbGraph+1): (6*nbGraph + nRest)){
maxY <- max(currentNISTData$temp[,input$ElementToExport[j]], na.rm = TRUE)
minX <- min(currentNISTData$temp[,1], na.rm = TRUE)
maxX <- max(currentNISTData$temp[,1], na.rm = TRUE)
plot(currentNISTData$temp[,1], currentNISTData$temp[,input$ElementToExport[j]],type ="b", ylab = "", xlab = "",
main = paste0("RawData_",input$ElementToExport[j]), col = "black", xlim = c(minX, maxX), ylim =c(0,maxY))
mtext("Signal intensity (cps)",side=2,line=2.4, cex=1.2)
mtext("Time (s)",side=1,line=1.5, at=par("usr")[2]-0.05*diff(par("usr")[1:2]), cex=1.2)
if((flagStandard$temp[which(as.matrix(currentProject()$standardsFiles) == input$standardIn)] %%2) == 0){
Temp$t <- currentProject()$closest(x = currentNISTData$temp[,1], y = input$bins[1])[[2]]
Temp0$t <- currentProject()$closest(x = currentNISTData$temp[,1], y = input$bins[2])[[2]]
Temp1$t <- currentProject()$closest(x = currentNISTData$temp[,1], y = input$plat[[1]])[[2]]
Temp2$t <- currentProject()$closest(x = currentNISTData$temp[,1], y = input$plat[[2]])[[2]]
} else if((flagStandard$temp[which(as.matrix(currentProject()$standardsFiles) == input$standardIn)] %%2) == 1){
Temp$t <- currentProject()$closest(x = currentNISTData$temp[,1], y = currentNISTRep$temp$bins[1])[[2]]
Temp0$t <- currentProject()$closest(x = currentNISTData$temp[,1], y = currentNISTRep$temp$bins[2])[[2]]
Temp1$t <- currentProject()$closest(x = currentNISTData$temp[,1], y = currentNISTRep$temp$plat[1])[[2]]
Temp2$t <- currentProject()$closest(x = currentNISTData$temp[,1], y = currentNISTRep$temp$plat[2])[[2]]
}
rect(currentNISTData$temp[Temp$t,1], -maxY,currentNISTData$temp[Temp0$t,1],(1+10/100)*maxY, col = "#8B735564", border = NA)
rect(currentNISTData$temp[Temp1$t,1],-maxY,currentNISTData$temp[Temp2$t,1],(1+10/100)*maxY, col ="#4F3CBC30", border = NA)
abline(v = currentNISTData$temp[Temp$t,1], lty = "dashed", col = "grey", lwd = 2)
abline(v = currentNISTData$temp[Temp0$t,1], lty = "dashed", col = "grey", lwd = 2)
abline(v = currentNISTData$temp[Temp1$t,1], lty = "dashed", col = "#4F3CBC50", lwd = 2)
abline(v = currentNISTData$temp[Temp2$t,1], lty = "dashed", col = "#4F3CBC50", lwd = 2)
points(currentNISTData$temp[Temp$t,1], currentNISTData$temp[Temp$t,input$ElementToExport[j]], cex = 3, col ="grey")
points(currentNISTData$temp[Temp0$t,1], currentNISTData$temp[Temp0$t,input$ElementToExport[j]], cex = 3, col ="grey")
points(currentNISTData$temp[Temp1$t,1], currentNISTData$temp[Temp1$t,input$ElementToExport[j]], cex = 3, col ="#4F3CBC50")
points(currentNISTData$temp[Temp2$t,1], currentNISTData$temp[Temp2$t,input$ElementToExport[j]], cex = 3, col ="#4F3CBC50")
}
title(input$standardIn, outer=TRUE, cex = 1.5)
dev.off()
}
info <- sprintf("%d%% done", round(40))
setTkProgressBar(pb, 40, sprintf("Export (%s)", info), info)
#### reduced Data exporting #####
for(i in seq(from = 1, to = length(input$ElementToExport), by = 1)){
for(j in seq(from = 1, to = length(input$courveToExport), by = 1)){
suppressWarnings(dir.create(paste0(projPath$temp,"/Results/standards/", temporaire, "/graphics/", input$ElementToExport[i])))
setwd(paste0(projPath$temp,"/Results/standards/", temporaire, "/graphics/", input$ElementToExport[i]))
if(input$courveToExport[j] == "Blank removed"){tempName <- "Blank_removed"
} else if(input$courveToExport[j] == "> LOD"){tempName <- "Supp_LOD"
} else if(input$courveToExport[j] == "Outliers free"){tempName <- "Outliers_free"
} else{tempName <- input$courveToExport[j]}
if(is.null(input$exportFormat)){
jpeg(filename = paste0("ReducedData",tempName,".jpg"), width = 760, height = 400)
} else {
if(input$exportFormat == ".jpeg"){
jpeg(filename = paste0("ReducedData",tempName,".jpg"), width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".bmp"){
bmp(filename = paste0("ReducedData",tempName,".bmp"), width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".png"){
png(filename = paste0("ReducedData",tempName,".png"), width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".tiff"){
tiff(filename = paste0("ReducedData",tempName,".tiff"), width = input$exportwidth, height = input$exportheight)
}
}
if((flagStandard$temp[which(as.matrix(currentProject()$standardsFiles) == input$standardIn)] %%2) == 0){
if(!is.null(input$bins) & !is.null(input$plat) & !is.null(Temp$t) & !is.null(Temp0$t) & !is.null(Temp1$t) & !is.null(Temp2$t)){
if(is.finite(Temp$t)){
curve <- currentNISTRep$temp$getData(curve = input$courveToExport[j], bins = c(Temp$t, Temp0$t),
plat = c(Temp1$t,Temp2$t), rempl = currentProject()$valRemplace, method = input$outlierDetect, nbOutliers = 3)
}
}
} else if((flagStandard$temp[which(as.matrix(currentProject()$standardsFiles) == input$standardIn)] %%2) == 1){
curve <- currentNISTRep$temp$renderData(curve = input$courveToExport[j])
}
if(length(which(!is.na(curve[,grep(input$ElementToExport[i], colnames(curve))]))) == 0){
plot(-1,-1, xlim = c(0,2), ylim = c(0,1),xlab = "", ylab = "")
text(1,0.5, labels = "No data different from NA", cex = 2)
} else{
par(mar = c(5.1,4.1,4.1,2))
plot(curve[,1], curve[,grep(input$ElementToExport[i], colnames(curve))], type ="b", ylab = "", xlab = "", main = "")
mtext("Signal intensity (cps)",side=2,line=2.6, cex=1.2)
mtext("Time (s)",side=1,line=2.3, at=par("usr")[2]-0.05*diff(par("usr")[1:2]), cex=1.2)
mtext(paste("Data Reduced",input$ElementToExport[i], input$courveToExport[j]),side=3,line=0.75, cex=1.2, font = 2)
}
dev.off()
}
}
info <- sprintf("%d%% done", round(70))
setTkProgressBar(pb, 70, sprintf("Export (%s)", info), info)
for(i in seq(from = 1, to = length(input$ElementToExport), by = 1)){
setwd(paste0(projPath$temp,"/Results/standards/", temporaire, "/graphics/", input$ElementToExport[i]))
if(length(input$courveToExport) <= 6) {
if(is.null(input$exportFormat)){
jpeg(filename = paste0("ReducedData_All.jpg"), width = 760, height = 400)
} else {
if(input$exportFormat == ".jpeg"){
jpeg(filename = "ReducedData_All.jpg", width = input$exportwidth, height = input$exportheight)
} else{}
if(input$exportFormat == ".bmp"){
bmp(filename = "ReducedData_All.bmp", width = input$exportwidth, height = input$exportheight)
} else{}
if(input$exportFormat == ".png"){
png(filename = "ReducedData_All.png", width = input$exportwidth, height = input$exportheight)
} else{}
if(input$exportFormat == ".tiff"){
tiff(filename = "ReducedData_All.tiff", width = input$exportwidth, height = input$exportheight)
} else{}
}
par(mfrow = c(2,3))
for(j in seq(from = 1, to = length(input$courveToExport), by = 1)){
if((flagStandard$temp[which(as.matrix(currentProject()$standardsFiles) == input$standardIn)] %%2) == 0){
if(!is.null(input$bins) & !is.null(input$plat) & !is.null(Temp$t) & !is.null(Temp0$t) & !is.null(Temp1$t) & !is.null(Temp2$t)){
if(is.finite(Temp$t)){
curve <- currentNISTRep$temp$getData(curve = input$courveToExport[j], bins = c(Temp$t, Temp0$t),
plat = c(Temp1$t,Temp2$t), rempl = currentProject()$valRemplace, method = input$outlierDetect, nbOutliers = 3)
}
}
} else if((flagStandard$temp[which(as.matrix(currentProject()$standardsFiles) == input$standardIn)] %%2) == 1){
curve <- currentNISTRep$temp$renderData(curve = input$courveToExport[j])
}
if(length(which(!is.na(curve[,grep(input$ElementToExport[i], colnames(curve))]))) == 0){
plot(-1,-1, xlim = c(0,2), ylim = c(0,1),xlab = "", ylab = "")
text(1,0.5, labels = "No data different from NA", cex = 2)
} else{
par(mar = c(5.1,4.1,4.1,2))
plot(curve[,1], curve[,grep(input$ElementToExport[i], colnames(curve))], type ="b", ylab = "", xlab = "", main = "")
mtext("Signal intensity (cps)",side=2,line=2.6, cex=1.2)
mtext("Time (s)",side=1,line=2.3, at=par("usr")[2]-0.05*diff(par("usr")[1:2]), cex=1.2)
mtext(paste("Data Reduced",input$ElementToExport[i], input$courveToExport[j]),side=3,line=0.75, cex=1.2, font = 2)
}
}
dev.off()
} else {
if(is.null(input$exportFormat)){
jpeg(filename = paste0("ReducedData_All.jpg"), width = 760, height = 400)
} else {
if(input$exportFormat == ".jpeg"){
jpeg(filename = "ReducedData_All.jpg", width = input$exportwidth, height = input$exportheight)
} else{}
if(input$exportFormat == ".bmp"){
bmp(filename = "ReducedData_All.bmp", width = input$exportwidth, height = input$exportheight)
} else{}
if(input$exportFormat == ".png"){
png(filename = "ReducedData_All.png", width = input$exportwidth, height = input$exportheight)
} else{}
if(input$exportFormat == ".tiff"){
tiff(filename = "ReducedData_All.tiff", width = input$exportwidth, height = input$exportheight)
} else{}
}
par(mfrow = c(2,3))
for(j in seq(from = 1, to = (length(input$courveToExport)-1), by = 1)){
if((flagStandard$temp[which(as.matrix(currentProject()$standardsFiles) == input$standardIn)] %%2) == 0){
if(!is.null(input$bins) & !is.null(input$plat) & !is.null(Temp$t) & !is.null(Temp0$t) & !is.null(Temp1$t) & !is.null(Temp2$t)){
if(is.finite(Temp$t)){
curve <- currentNISTRep$temp$getData(curve = input$courveToExport[j], bins = c(Temp$t, Temp0$t),
plat = c(Temp1$t,Temp2$t), rempl = currentProject()$valRemplace, method = input$outlierDetect, nbOutliers = 3)
}
}
} else if((flagStandard$temp[which(as.matrix(currentProject()$standardsFiles) == input$standardIn)] %%2) == 1){
curve <- currentNISTRep$temp$renderData(curve = input$courveToExport[j])
}
if(length(which(!is.na(curve[,grep(input$ElementToExport[i], colnames(curve))]))) == 0){
plot(-1,-1, xlim = c(0,2), ylim = c(0,1),xlab = "", ylab = "")
text(1,0.5, labels = "No data different from NA", cex = 2)
} else{
par(mar = c(5.1,4.1,4.1,2))
plot(curve[,1], curve[,grep(input$ElementToExport[i], colnames(curve))], type ="b", ylab = "", xlab = "", main = "")
mtext("Signal intensity (cps)",side=2,line=2.6, cex=1.2)
mtext("Time (s)",side=1,line=2.3, at=par("usr")[2]-0.05*diff(par("usr")[1:2]), cex=1.2)
mtext(paste("Data Reduced",input$ElementToExport[i], input$courveToExport[j]),side=3,line=0.75, cex=1.2, font = 2)
}
}
dev.off()
if(is.null(input$exportFormat)){
jpeg(filename = paste0("ReducedData_All2.jpg"), width = 760, height = 400)
} else{
if(input$exportFormat == ".jpeg"){
jpeg(filename = "ReducedData_All2.jpg", width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".bmp"){
bmp(filename = "ReducedData_All2.bmp", width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".png"){
png(filename = "ReducedData_All2.png", width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".tiff"){
tiff(filename = "ReducedData_All2.tiff", width = input$exportwidth, height = input$exportheight)
}
}
par(mfrow = c(2,3))
if((flagStandard$temp[which(as.matrix(currentProject()$standardsFiles) == input$standardIn)] %%2) == 0){
if(!is.null(input$bins) & !is.null(input$plat) & !is.null(Temp$t) & !is.null(Temp0$t) & !is.null(Temp1$t) & !is.null(Temp2$t)){
if(is.finite(Temp$t)){
curve <- currentNISTRep$temp$getData(curve = input$courveToExport[length(input$courveToExport)],
bins = c(Temp$t, Temp0$t), plat = c(Temp1$t,Temp2$t), rempl = currentProject()$valRemplace, method = input$outlierDetect, nbOutliers = 3)
}
}
} else if((flagStandard$temp[which(as.matrix(currentProject()$standardsFiles) == input$standardIn)] %%2) == 1){
curve <- currentNISTRep$temp$renderData(curve = input$courveToExport[length(input$courveToExport)])
}
if(length(which(!is.na(curve[,grep(input$ElementToExport[i], colnames(curve))]))) == 0){
plot(-1,-1, xlim = c(0,2), ylim = c(0,1),xlab = "", ylab = "")
text(1,0.5, labels = "No data different from NA", cex = 2)
} else{
par(mar = c(5.1,4.1,4.1,2))
plot(curve[,1], curve[,grep(input$ElementToExport[length(input$ElementToExport)], colnames(curve))], type ="b", ylab = "", xlab = "", main = "")
mtext("Signal intensity (cps)",side=2,line=2.6, cex=1.2)
mtext("Time (s)",side=1,line=2.3, at=par("usr")[2]-0.05*diff(par("usr")[1:2]), cex=1.2)
mtext(paste("Data Reduced",input$ElementToExport[i], input$courveToExport[length(input$courveToExport)]),side=3,line=0.75, cex=1.2, font = 2)
}
dev.off()
}
}
info <- sprintf("%d%% done", round(90))
setTkProgressBar(pb, 90, sprintf("Export (%s)", info), info)
setwd(espace1)
info <- sprintf("%d%% done", round(100))
setTkProgressBar(pb, 100, sprintf("Export (%s)", info), info)
close(pb)
res <- tkmessageBox(title = "INFO !",message = "Graphics exported", icon = "info", type = "ok")
} else {tkmessageBox(message = "You need to select at least one element to export!", icon = "error", type = "ok")}
} else {tkmessageBox(message = "You need to select at least one curve to export!", icon = "error", type = "ok")}
})
}
}
})
observe({
if(!is.null(input$ExportGraphS)){
if(input$ExportGraphS > 0){
isolate({
espace1 <- getwd()
temporaire <- input$SampleIn2
suppressWarnings(dir.create(paste0(projPath$temp,"/Results/samples/", input$SampleIn, "/", temporaire, "/graphics")))
setwd(paste0(projPath$temp,"/Results/samples/", input$SampleIn, "/", temporaire, "/graphics"))
if(!is.null(length(input$courveToExportS)) & length(input$courveToExportS) != 0){
if(!is.null(length(input$ElementToExportS)) & length(input$ElementToExportS) != 0){
pb <- tkProgressBar("Progress bar", "Graphic export in %",
0, 100, 0)
#### Raw Data exporting #####
if(is.null(input$exportFormat)){
jpeg(filename = paste0("RawData_",temporaire ,".jpg"), width = 760, height = 400)
} else{
if(input$exportFormat == ".jpeg"){
jpeg(filename = paste0("RawData_",temporaire ,".jpg"), width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".bpm"){
bmp(filename = paste0("RawData_",temporaire ,".bmp"), width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".png"){
png(filename = paste0("RawData_",temporaire ,".png"), width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".tiff"){
tiff(filename = paste0("RawData_",temporaire ,".tiff"), width = input$exportwidth, height = input$exportheight)
}
}
mat<- matrix(c(1,1,1,1,1,1,1,1,1,2),1)
layout(mat)
par(mar = c(5.1,4.1,4.1,2))
if(length(grep(input$SampleIn2,currentProject()$samples[[currentSampleNumberRep$temp]]$rep_Files)) != 0){
maxY <- max(currentSampleData$temp, na.rm = TRUE)
minX <- min(currentSampleData$temp[,1], na.rm = TRUE)
maxX <- max(currentSampleData$temp[,1], na.rm = TRUE)
plot(currentSampleData$temp[,1], currentSampleData$temp[,input$ElementToExportS[1]],type ="b", ylab = "", xlab = "", main = "",
col = color$temp[which(input$ElementToExportS[1] == names(color$temp))], xlim = c(minX, maxX), ylim =c(0,maxY))
mtext("Signal intensity (cps)",side=2,line=2.4, cex=1.2)
mtext("Time (s)",side=1,line=1.5, at=par("usr")[2]-0.05*diff(par("usr")[1:2]), cex=1.2)
mtext("Raw data",side=3,line=0.75, cex=1.2, font = 2)
lapply(seq(from = 1, to = length(input$ElementToExportS), by = 1), function(x){
par(new = TRUE)
plot(currentSampleData$temp[,1], currentSampleData$temp[,input$ElementToExportS[x]],type ="b",
ylab = "", xlab = "", main = "", col = color$temp[which(input$ElementToExportS[x] == names(color$temp))],
xlim = c(minX, maxX), ylim =c(0,maxY), axes = FALSE)
})
if((flagSampleDetail$temp[[currentSampleNumberRep$temp]][grep(input$SampleIn2,currentProject()$samples[[currentSampleNumberRep$temp]]$rep_Files)]%%2) == 0){
TempS$t <- currentProject()$closest(x = currentSampleData$temp[,1],y = input$binsSample[1])[[2]]
Temp0S$t <- currentProject()$closest(x = currentSampleData$temp[,1],y = input$binsSample[2])[[2]]
Temp1S$t <- currentProject()$closest(x = currentSampleData$temp[,1],y = input$platSample[1])[[2]]
Temp2S$t <- currentProject()$closest(x = currentSampleData$temp[,1],y = input$platSample[2])[[2]]
} else {
TempS$t <- currentProject()$closest(x = currentSampleData$temp[,1],y = currentSampleRep$temp$bins[1])[[2]]
Temp0S$t <- currentProject()$closest(x = currentSampleData$temp[,1],y = currentSampleRep$temp$bins[2])[[2]]
Temp1S$t <- currentProject()$closest(x = currentSampleData$temp[,1],y = currentSampleRep$temp$plat[1])[[2]]
Temp2S$t <- currentProject()$closest(x = currentSampleData$temp[,1],y = currentSampleRep$temp$plat[2])[[2]]
}
rect(currentSampleData$temp[TempS$t,1],-maxY,currentSampleData$temp[Temp0S$t,1],(1+10/100)*maxY, col = "#8B735564", border = NA)
rect(currentSampleData$temp[Temp1S$t,1],-maxY,currentSampleData$temp[Temp2S$t,1],(1+10/100)*maxY, col = "#4F3CBC30", border = NA)
abline(v = currentSampleData$temp[TempS$t,1], lty = "dashed", col = ("grey"), lwd = 2)
abline(v = currentSampleData$temp[Temp0S$t,1], lty = "dashed", col = ("grey"), lwd = 2)
abline(v = currentSampleData$temp[Temp1S$t,1], lty = "dashed", col = ("#4F3CBC50"), lwd = 2)
abline(v = currentSampleData$temp[Temp2S$t,1], lty = "dashed", col = ("#4F3CBC50"), lwd = 2)
lapply(seq(from = 1, to = length(input$ElementToExportS), by = 1), function(x){points(currentSampleData$temp[TempS$t,1], currentSampleData$temp[TempS$t,x], cex = 3, col ="grey")})
lapply(seq(from = 1, to = length(input$ElementToExportS), by = 1), function(x){points(currentSampleData$temp[Temp0S$t,1], currentSampleData$temp[Temp0S$t,x], cex = 3, col ="grey")})
lapply(seq(from = 1, to = length(input$ElementToExportS), by = 1), function(x){points(currentSampleData$temp[Temp1S$t,1], currentSampleData$temp[Temp1S$t,x], cex = 3, col ="#4F3CBC50")})
lapply(seq(from = 1, to = length(input$ElementToExportS), by = 1), function(x){points(currentSampleData$temp[Temp2S$t,1], currentSampleData$temp[Temp2S$t,x], cex = 3, col ="#4F3CBC50")})
}
par(mar = c(0,0,2,1))
plot(0,0, axes = FALSE, type = "n")
legend(-1,1, legend = input$ElementToExportS, bty = "n", col = color$temp[vapply(seq(from = 1, to = length(input$ElementToExportS), by = 1),
function(x) {which(input$ElementToExportS[x] == names(color$temp))
},
FUN.VALUE = numeric(1)
)
], pch = 16, cex = 1.5)
dev.off()
info <- sprintf("%d%% done", round(10))
setTkProgressBar(pb, 10, sprintf("Export (%s)", info), info)
nbGraph <- floor(length(input$ElementToExportS)/6)
nRest <- length(input$ElementToExportS)%%6
if(nbGraph > 0){
for(i in seq(from = 1, to = nbGraph, by = 1)){
if(is.null(input$exportFormat)){
jpeg(filename = paste0("RawData_All_graph",i,".jpg"), width = 760, height = 400)
} else {
if(input$exportFormat == ".jpeg"){
jpeg(filename = paste0("RawData_All_graph",i,".jpg"), width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".bmp"){
bmp(filename = paste0("RawData_All_graph",i,".bmp"), width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".png"){
png(filename = paste0("RawData_All_graph",i,".png"), width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".tiff"){
tiff(filename = paste0("RawData_All_graph",i,".tiff"), width = input$exportwidth, height = input$exportheight)
}
}
par(mfrow = c(2,3), mar = c(3,4.1,2,2), oma=c(0,0,1,0))
for(j in (6*(i-1)+1):(6*i)){
maxY <- max(currentSampleData$temp[, input$ElementToExportS[j]], na.rm = TRUE)
minX <- min(currentSampleData$temp[,1], na.rm = TRUE)
maxX <- max(currentSampleData$temp[,1], na.rm = TRUE)
plot(currentSampleData$temp[,1], currentSampleData$temp[,input$ElementToExportS[j]],type ="b", ylab = "", xlab = "", main = paste0("RawData_",input$ElementToExportS[j]), col = "black", xlim = c(minX, maxX), ylim =c(0,maxY))
mtext("Signal intensity (cps)",side=2,line=2.4, cex=1.2)
mtext("Time (s)",side=1,line=1.5, at=par("usr")[2]-0.05*diff(par("usr")[1:2]), cex=1.2)
if((flagSampleDetail$temp[[currentSampleNumberRep$temp]][grep(input$SampleIn2,currentProject()$samples[[currentSampleNumberRep$temp]]$rep_Files)]%%2) == 0){
TempS$t <- currentProject()$closest(x = currentSampleData$temp[,1],y = input$binsSample[1])[[2]]
Temp0S$t <- currentProject()$closest(x = currentSampleData$temp[,1],y = input$binsSample[2])[[2]]
Temp1S$t <- currentProject()$closest(x = currentSampleData$temp[,1],y = input$platSample[1])[[2]]
Temp2S$t <- currentProject()$closest(x = currentSampleData$temp[,1],y = input$platSample[2])[[2]]
} else {
TempS$t <- currentProject()$closest(x = currentSampleData$temp[,1],y = currentSampleRep$temp$bins[1])[[2]]
Temp0S$t <- currentProject()$closest(x = currentSampleData$temp[,1],y = currentSampleRep$temp$bins[2])[[2]]
Temp1S$t <- currentProject()$closest(x = currentSampleData$temp[,1],y = currentSampleRep$temp$plat[1])[[2]]
Temp2S$t <- currentProject()$closest(x = currentSampleData$temp[,1],y = currentSampleRep$temp$plat[2])[[2]]
}
rect(currentSampleData$temp[TempS$t,1],-maxY,currentSampleData$temp[Temp0S$t,1],(1+10/100)*maxY, col = "#8B735564", border = NA)
rect(currentSampleData$temp[Temp1S$t,1],-maxY,currentSampleData$temp[Temp2S$t,1],(1+10/100)*maxY, col ="#4F3CBC30", border = NA)
abline(v = currentSampleData$temp[TempS$t,1], lty = "dashed", col = ("grey"), lwd = 2)
abline(v = currentSampleData$temp[Temp0S$t,1], lty = "dashed", col = ("grey"), lwd = 2)
abline(v = currentSampleData$temp[Temp1S$t,1], lty = "dashed", col = ("#4F3CBC50"), lwd = 2)
abline(v = currentSampleData$temp[Temp2S$t,1], lty = "dashed", col = ("#4F3CBC50"), lwd = 2)
points(currentSampleData$temp[TempS$t,1], currentSampleData$temp[TempS$t,input$ElementToExportS[j]], cex = 3, col ="grey")
points(currentSampleData$temp[Temp0S$t,1], currentSampleData$temp[Temp0S$t,input$ElementToExportS[j]], cex = 3, col ="grey")
points(currentSampleData$temp[Temp1S$t,1], currentSampleData$temp[Temp1S$t,input$ElementToExportS[j]], cex = 3, col ="#4F3CBC50")
points(currentSampleData$temp[Temp2S$t,1], currentSampleData$temp[Temp2S$t,input$ElementToExportS[j]], cex = 3, col ="#4F3CBC50")
}
title(temporaire, outer=TRUE, cex = 1.5)
dev.off()
}
}
if(nRest != 0){
if(is.null(input$exportFormat)){
jpeg(filename = paste0("RawData_All_graph",nbGraph+1,".jpg"), width = 760, height = 400)
}else{
if(input$exportFormat == ".jpeg"){
jpeg(filename = paste0("RawData_All_graph",nbGraph+1,".jpg"), width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".bmp"){
bmp(filename = paste0("RawData_All_graph",nbGraph+1,".bmp"), width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".png"){
png(filename = paste0("RawData_All_graph",nbGraph+1,".png"), width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".tiff"){
tiff(filename = paste0("RawData_All_graph",nbGraph+1,".tiff"), width = input$exportwidth, height = input$exportheight)
}
}
par(mfrow = c(2,3), mar = c(3,4.1,2,2), oma=c(0,0,1,0))
for(j in (6*nbGraph+1): (6*nbGraph + nRest)){
maxY <- max(currentSampleData$temp[, input$ElementToExportS[j]], na.rm = TRUE)
minX <- min(currentSampleData$temp[,1], na.rm = TRUE)
maxX <- max(currentSampleData$temp[,1], na.rm = TRUE)
plot(currentSampleData$temp[,1], currentSampleData$temp[,input$ElementToExportS[j]],type ="b", ylab = "", xlab = "", main = paste0("RawData_",input$ElementToExportS[j]), col = "black", xlim = c(minX, maxX), ylim =c(0,maxY))
mtext("Signal intensity (cps)",side=2,line=2.4, cex=1.2)
mtext("Time (s)",side=1,line=1.5, at=par("usr")[2]-0.05*diff(par("usr")[1:2]), cex=1.2)
if((flagSampleDetail$temp[[currentSampleNumberRep$temp]][grep(input$SampleIn2,currentProject()$samples[[currentSampleNumberRep$temp]]$rep_Files)]%%2) == 0){
TempS$t <- currentProject()$closest(x = currentSampleData$temp[,1],y = input$binsSample[1])[[2]]
Temp0S$t <- currentProject()$closest(x = currentSampleData$temp[,1],y = input$binsSample[2])[[2]]
Temp1S$t <- currentProject()$closest(x = currentSampleData$temp[,1],y = input$platSample[1])[[2]]
Temp2S$t <- currentProject()$closest(x = currentSampleData$temp[,1],y = input$platSample[2])[[2]]
} else {
TempS$t <- currentProject()$closest(x = currentSampleData$temp[,1],y = currentSampleRep$temp$bins[1])[[2]]
Temp0S$t <- currentProject()$closest(x = currentSampleData$temp[,1],y = currentSampleRep$temp$bins[2])[[2]]
Temp1S$t <- currentProject()$closest(x = currentSampleData$temp[,1],y = currentSampleRep$temp$plat[1])[[2]]
Temp2S$t <- currentProject()$closest(x = currentSampleData$temp[,1],y = currentSampleRep$temp$plat[2])[[2]]
}
rect(currentSampleData$temp[TempS$t,1],-maxY,currentSampleData$temp[Temp0S$t,1],(1+10/100)*maxY, col = "#8B735564", border = NA)
rect(currentSampleData$temp[Temp1S$t,1],-maxY,currentSampleData$temp[Temp2S$t,1],(1+10/100)*maxY, col ="#4F3CBC30", border = NA)
abline(v = currentSampleData$temp[TempS$t,1], lty = "dashed", col = ("grey"), lwd = 2)
abline(v = currentSampleData$temp[Temp0S$t,1], lty = "dashed", col = ("grey"), lwd = 2)
abline(v = currentSampleData$temp[Temp1S$t,1], lty = "dashed", col = ("#4F3CBC50"), lwd = 2)
abline(v = currentSampleData$temp[Temp2S$t,1], lty = "dashed", col = ("#4F3CBC50"), lwd = 2)
points(currentSampleData$temp[TempS$t,1], currentSampleData$temp[TempS$t,input$ElementToExportS[j]], cex = 3, col ="grey")
points(currentSampleData$temp[Temp0S$t,1], currentSampleData$temp[Temp0S$t,input$ElementToExportS[j]], cex = 3, col ="grey")
points(currentSampleData$temp[Temp1S$t,1], currentSampleData$temp[Temp1S$t,input$ElementToExportS[j]], cex = 3, col ="#4F3CBC50")
points(currentSampleData$temp[Temp2S$t,1], currentSampleData$temp[Temp2S$t,input$ElementToExportS[j]], cex = 3, col ="#4F3CBC50")
}
title(input$standardIn, outer=TRUE, cex = 1.5)
dev.off()
}
info <- sprintf("%d%% done", round(40))
setTkProgressBar(pb, 40, sprintf("Export (%s)", info), info)
#### Reduced Data exporting #####
for(i in seq(from = 1, to = length(input$ElementToExportS), by = 1)){
for(j in seq(from = 1, to = length(input$courveToExportS), by = 1)){
suppressWarnings(dir.create(paste0(projPath$temp,"/Results/samples/", input$SampleIn, "/", temporaire, "/graphics/", input$ElementToExportS[i])))
setwd(paste0(projPath$temp,"/Results/samples/", input$SampleIn, "/", temporaire, "/graphics/", input$ElementToExportS[i]))
if(input$courveToExportS[j] == "Blank removed"){tempNameS <- "Blank_removed"
} else if(input$courveToExportS[j] == "> LOD"){tempNameS <- "Supp_LOD"
} else if(input$courveToExportS[j] == "Conc. corrected"){tempNameS <- "Conc._corrected"
} else{tempNameS <- input$courveToExportS[j]}
if(is.null(input$exportFormat)){
jpeg(filename = paste0("ReducedData",tempNameS,".jpg"), width = 760, height = 400)
} else{
if(input$exportFormat == ".jpeg"){
jpeg(filename = paste0("ReducedData",tempNameS,".jpg"), width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".bmp"){
bmp(filename = paste0("ReducedData",tempNameS,".bmp"), width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".png"){
png(filename = paste0("ReducedData",tempNameS,".png"), width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".tiff"){
tiff(filename = paste0("ReducedData",tempNameS,".tiff"), width = input$exportwidth, height = input$exportheight)
}
}
if(length(currentSampleRep$temp) != 0){
if(length(grep(input$SampleIn2,currentProject()$samples[[currentSampleNumberRep$temp]]$rep_Files)) == 0){
} else {
if((flagSampleDetail$temp[[currentSampleNumberRep$temp]][grep(input$SampleIn2,currentProject()$samples[[currentSampleNumberRep$temp]]$rep_Files)]%%2) == 0){
if(!is.null(input$bins) & !is.null(input$plat) & !is.null(Temp$t) & !is.null(Temp0$t) & !is.null(Temp1$t) & !is.null(Temp2$t)){
if(is.finite(TempS$t)){
curveS <- currentSampleRep$temp$getData(curve = input$courveToExportS[j],
bins = c(TempS$t, Temp0S$t),
plat = c(Temp1S$t,Temp2S$t),
name = input$SampleIn2,
meanStand = currentProject()$standards[[1]]$rep_dataFinale,
rankSample = currentProject()$sampleRank,
rankStandard = currentProject()$standardRank,
model = currentProject()$regressionModel,
calibFile = currentProject()$EtalonData,
correction = currentProject()$machineCorrection,
rempl = currentProject()$valRemplace,threshold = currentProject()$R2Threshold)
}
}
} else if((flagSampleDetail$temp[[currentSampleNumberRep$temp]][grep(input$SampleIn2,currentProject()$samples[[currentSampleNumberRep$temp]]$rep_Files)]%%2) == 1){
if(is.finite(TempS$t)){
curveS <- currentSampleRep$temp$renderData(curve = input$courveToExportS[j])
}
}
}
}
if(!is.null(curveS)){
if(length(which(!is.na(curveS[,grep(input$ElementToExportS[i], colnames(curveS))]))) == 0){
plot(-1,-1, xlim = c(0,2), ylim = c(0,1),xlab = "", ylab = "")
text(1,0.5, labels = "No data different from NA", cex = 2)
} else{
par(mar = c(5.1,4.1,4.1,2))
plot(curveS[,1], curveS[,grep(input$ElementToExportS[i], colnames(curveS))], type ="b", ylab = "", xlab = "", main = "")
mtext("Signal intensity (cps)",side=2,line=2.6, cex=1.2)
mtext("Time (s)",side=1,line=2.3, at=par("usr")[2]-0.05*diff(par("usr")[1:2]), cex=1.2)
mtext(paste("Data Reduced",input$ElementToExportS[i], input$courveToExportS[j]),side=3,line=0.75, cex=1.2, font = 2)
}
} else{}
dev.off()
}
}
info <- sprintf("%d%% done", round(70))
setTkProgressBar(pb, 70, sprintf("Export (%s)", info), info)
for(i in seq(from = 1, to = length(input$ElementToExportS), by = 1)){
setwd(paste0(projPath$temp,"/Results/samples/", input$SampleIn, "/", temporaire, "/graphics/", input$ElementToExportS[i]))
if(length(input$courveToExportS) <= 6) {
if(is.null(input$exportFormat)){
jpeg(filename = "ReducedData_All.jpg", width = 760, height = 400)
} else{
if(input$exportFormat == ".jpeg"){
jpeg(filename = "ReducedData_All.jpg", width = input$exportwidth, height = input$exportheight)
} else{}
if(input$exportFormat == ".bmp"){
bmp(filename = "ReducedData_All.bmp", width = input$exportwidth, height = input$exportheight)
} else{}
if(input$exportFormat == ".png"){
png(filename = "ReducedData_All.png", width = input$exportwidth, height = input$exportheight)
} else{}
if(input$exportFormat == ".tiff"){
tiff(filename = "ReducedData_All.tiff", width = input$exportwidth, height = input$exportheight)
} else{}
}
par(mfrow = c(2,3))
for(j in seq(from = 1, to = length(input$courveToExportS), by = 1)){
if(length(currentSampleRep$temp) != 0){
if(length(grep(input$SampleIn2,currentProject()$samples[[currentSampleNumberRep$temp]]$rep_Files)) == 0){
}else if((flagSampleDetail$temp[[currentSampleNumberRep$temp]][grep(input$SampleIn2,currentProject()$samples[[currentSampleNumberRep$temp]]$rep_Files)]%%2) == 0){
if(!is.null(input$bins) & !is.null(input$plat) & !is.null(Temp$t) & !is.null(Temp0$t) & !is.null(Temp1$t) & !is.null(Temp2$t)){
if(is.finite(TempS$t)){curveS <- currentSampleRep$temp$getData(curve = input$courveToExportS[j],
bins = c(TempS$t, Temp0S$t),
plat = c(Temp1S$t,Temp2S$t),
name = input$SampleIn2,
meanStand = currentProject()$standards[[1]]$rep_dataFinale,
rankSample = currentProject()$sampleRank,
rankStandard = currentProject()$standardRank,
model = currentProject()$regressionModel,
calibFile = currentProject()$EtalonData,
correction = currentProject()$machineCorrection,
rempl = currentProject()$valRemplace,
threshold = currentProject()$R2Threshold)
}
}
} else if((flagSampleDetail$temp[[currentSampleNumberRep$temp]][grep(input$SampleIn2,currentProject()$samples[[currentSampleNumberRep$temp]]$rep_Files)]%%2) == 1){
if(is.finite(TempS$t)){
curveS <- currentSampleRep$temp$renderData(curve = input$courveToExportS[j])
}
}
}
if(!is.null(curveS)){
if(length(which(!is.na(curveS[,grep(input$ElementToExportS[i], colnames(curveS))]))) == 0){
plot(-1,-1, xlim = c(0,2), ylim = c(0,1),xlab = "", ylab = "")
text(1,0.5, labels = "No data different from NA", cex = 2)
mtext("Signal intensity (cps)",side=2,line=2.6, cex=1.2)
mtext("Time (s)",side=1,line=2.3, at=par("usr")[2]-0.05*diff(par("usr")[1:2]), cex=1.2)
mtext(paste("Data Reduced",input$ElementToExportS[i], input$courveToExportS[j]),side=3,line=0.75, cex=1.2, font = 2)
} else {
par(mar = c(3.5,3.7,1.75,1))
plot(curveS[,1], curveS[,grep(input$ElementToExportS[i], colnames(curveS))], type ="b", ylab = "", xlab = "", main = "")
mtext("Signal intensity (cps)",side=2,line=2.6, cex=1.2)
mtext("Time (s)",side=1,line=2.3, at=par("usr")[2]-0.05*diff(par("usr")[1:2]), cex=1.2)
mtext(paste("Data Reduced",input$ElementToExportS[i], input$courveToExportS[j]),side=3,line=0.75, cex=1.2, font = 2)
}
}else{}
}
dev.off()
} else{
if(is.null(input$exportFormat)){
jpeg(filename = "ReducedData_All.jpg", width = 760, height = 400)
} else{
if(input$exportFormat == ".jpeg"){
jpeg(filename = "ReducedData_All.jpg", width = input$exportwidth, height = input$exportheight)
} else{}
if(input$exportFormat == ".bmp"){
bmp(filename = "ReducedData_All.bmp", width = input$exportwidth, height = input$exportheight)
} else{}
if(input$exportFormat == ".png"){
png(filename = "ReducedData_All.png", width = input$exportwidth, height = input$exportheight)
} else{}
if(input$exportFormat == ".tiff"){
tiff(filename = "ReducedData_All.tiff", width = input$exportwidth, height = input$exportheight)
} else{}
}
par(mfrow = c(2,3))
for(j in seq(from = 1, to = length(input$courveToExportS), by = 1)){
if(length(currentSampleRep$temp) != 0){
if(length(grep(input$SampleIn2,currentProject()$samples[[currentSampleNumberRep$temp]]$rep_Files)) == 0){
}else if((flagSampleDetail$temp[[currentSampleNumberRep$temp]][grep(input$SampleIn2,currentProject()$samples[[currentSampleNumberRep$temp]]$rep_Files)]%%2) == 0){
if(!is.null(input$bins) & !is.null(input$plat) & !is.null(Temp$t) & !is.null(Temp0$t) & !is.null(Temp1$t) & !is.null(Temp2$t)){
if(is.finite(TempS$t)){curveS <- currentSampleRep$temp$getData(curve = input$courveToExportS[j],
bins = c(TempS$t, Temp0S$t),
plat = c(Temp1S$t,Temp2S$t),
name = input$SampleIn2,
meanStand = currentProject()$standards[[1]]$rep_dataFinale,
rankSample = currentProject()$sampleRank,
rankStandard = currentProject()$standardRank,
model = currentProject()$regressionModel,
calibFile = currentProject()$EtalonData, correction = currentProject()$machineCorrection,
rempl = currentProject()$valRemplace,
threshold = currentProject()$R2Threshold)
}
}
} else if((flagSampleDetail$temp[[currentSampleNumberRep$temp]][grep(input$SampleIn2,currentProject()$samples[[currentSampleNumberRep$temp]]$rep_Files)]%%2) == 1){
if(is.finite(TempS$t)){
curveS <- currentSampleRep$temp$renderData(curve = input$courveToExportS[j])
}
}
}
if(!is.null(curveS)){
if(length(which(!is.na(curveS[,grep(input$ElementToExportS[i], colnames(curveS))]))) == 0){
plot(-1,-1, xlim = c(0,2), ylim = c(0,1),xlab = "", ylab = "")
text(1,0.5, labels = "No data different from NA", cex = 2)
mtext("Signal intensity (cps)",side=2,line=2.6, cex=1.2)
mtext("Time (s)",side=1,line=2.3, at=par("usr")[2]-0.05*diff(par("usr")[1:2]), cex=1.2)
mtext(paste("Data Reduced",input$ElementToExportS[i], input$courveToExportS[j]),side=3,line=0.75, cex=1.2, font = 2)
} else {
par(mar = c(5.1,4.1,4.1,2))
plot(curveS[,1], curveS[,grep(input$ElementToExportS[i], colnames(curveS))], type ="b", ylab = "", xlab = "", main = "")
mtext("Signal intensity (cps)",side=2,line=2.6, cex=1.2)
mtext("Time (s)",side=1,line=2.3, at=par("usr")[2]-0.05*diff(par("usr")[1:2]), cex=1.2)
mtext(paste("Data Reduced",input$ElementToExportS[i], input$courveToExportS[j]),side=3,line=0.75, cex=1.2, font = 2)
}
}else{}
}
dev.off()
if(is.null(input$exportFormat)){
jpeg(filename = "ReducedData_All2.jpg", width = 760, height = 400)
} else{
if(input$exportFormat == ".jpeg"){
jpeg(filename = "ReducedData_All2.jpg", width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".bmp"){
bmp(filename = "ReducedData_All2.bmp", width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".png"){
png(filename = "ReducedData_All2.png", width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".tiff"){
tiff(filename = "ReducedData_All2.tiff", width = input$exportwidth, height = input$exportheight)
}
}
par(mfrow = c(2,3))
for(j in (length(input$courveToExportS)-2): (length(input$courveToExportS))){
if(length(currentSampleRep$temp) != 0){
if(length(grep(input$SampleIn2,currentProject()$samples[[currentSampleNumberRep$temp]]$rep_Files)) == 0){
}else{
if((flagSampleDetail$temp[[currentSampleNumberRep$temp]][grep(input$SampleIn2,currentProject()$samples[[currentSampleNumberRep$temp]]$rep_Files)]%%2) == 0){
if(!is.null(input$bins) & !is.null(input$plat) & !is.null(Temp$t) & !is.null(Temp0$t) & !is.null(Temp1$t) & !is.null(Temp2$t)){
if(is.finite(TempS$t)){curveS <- currentSampleRep$temp$getData(curve = input$courveToExportS[j],
bins = c(TempS$t, Temp0S$t),
plat = c(Temp1S$t,Temp2S$t),
name = input$SampleIn2,
meanStand = currentProject()$standards[[1]]$rep_dataFinale,
rankSample = currentProject()$sampleRank,
rankStandard = currentProject()$standardRank,
model = currentProject()$regressionModel,
calibFile = currentProject()$EtalonData,
correction = currentProject()$machineCorrection,
rempl = currentProject()$valRemplace,
threshold = currentProject()$R2Threshold)
}
}
} else if((flagSampleDetail$temp[[currentSampleNumberRep$temp]][grep(input$SampleIn2,currentProject()$samples[[currentSampleNumberRep$temp]]$rep_Files)]%%2) == 1){
if(is.finite(TempS$t)){curveS <- currentSampleRep$temp$renderData(curve = input$courveToExportS[j])
}
}
}
}
if(!is.null(curveS)){
if(length(which(!is.na(curveS[,grep(input$ElementToExportS[i], colnames(curveS))]))) == 0){
plot(-1,-1, xlim = c(0,2), ylim = c(0,1),xlab = "", ylab = "")
text(1,0.5, labels = "No data different from NA", cex = 2)
mtext("Signal intensity (cps)",side=2,line=2.6, cex=1.2)
mtext("Time (s)",side=1,line=2.3, at=par("usr")[2]-0.05*diff(par("usr")[1:2]), cex=1.2)
mtext(paste("Data Reduced",input$ElementToExportS[i], input$courveToExportS[j]),side=3,line=0.75, cex=1.2, font = 2)
} else{
par(mar = c(5.1,4.1,4.1,2))
plot(curveS[,1], curveS[,grep(input$ElementToExportS[i], colnames(curveS))], type ="b", ylab = "", xlab = "", main = "")
mtext("Signal intensity (cps)",side=2,line=2.6, cex=1.2)
mtext("Time (s)",side=1,line=2.3, at=par("usr")[2]-0.05*diff(par("usr")[1:2]), cex=1.2)
mtext(paste("Data Reduced",input$ElementToExportS[i], input$courveToExportS[j]),side=3,line=0.75, cex=1.2, font = 2)
}
} else{}
}
dev.off()
}
}
info <- sprintf("%d%% done", round(90))
setTkProgressBar(pb, 90, sprintf("Export (%s)", info), info)
setwd(espace1)
info <- sprintf("%d%% done", round(100))
setTkProgressBar(pb, 100, sprintf("Export (%s)", info), info)
close(pb)
res <- tkmessageBox(title = "INFO !",message = "Graphics exported", icon = "info", type = "ok")
} else {tkmessageBox(message = "You need to select at least one element to export!", icon = "error", type = "ok")}
} else {tkmessageBox(message = "You need to select at least one curve to export!", icon = "error", type = "ok")}
})
}
}
})
observe({
if(!is.null(input$MachDriftExportGraph)){
if(input$MachDriftExportGraph>0){
isolate({
espace1 <- getwd()
setwd(paste0(projPath$temp,"/Results/"))
if(is.null(length(input$MachDriftElementToExport)) | length(input$MachDriftElementToExport) == 0){
tkmessageBox(message = "You need to select at least one element to export!", icon = "error", type = "ok")
}else{
pb <- tkProgressBar("Progress bar", "Graphic export in %",
0, 100, 0)
threeTemp <-intersect(which(currentProject()$nbCalib >= 3), vapply(seq(from = 1, to = length(input$MachDriftElementToExport), by = 1),
function(x){which(input$MachDriftElementToExport[x] == names(currentProject()$nbCalib))},
FUN.VALUE = numeric(1)))
three <- input$MachDriftElementToExport[threeTemp]
nbGraph <- floor(length(three)/6)
nRest <- length(three)%%6
temporaryTab <- currentProject()$standards[[1]]$rep_dataFinale
temp <- str_sub(rownames(temporaryTab), 1, -6)
X <- vector()
for (i in seq(from = 1, to = length(currentProject()$standardsFiles), by = 1)){
X[i] <- currentProject()$standardRank[which(names(currentProject()$standardRank) == temp[i])]
}
if(nbGraph > 0){
for(i in seq(from = 1, to = nbGraph, by = 1)){
if(is.null(input$exportFormat)){
jpeg(filename = paste0("Machine_Drift_3_&_Sup",i,".jpg"), width = 760, height = 400)
} else{
if(input$exportFormat == ".jpeg"){
jpeg(filename = paste0("Machine_Drift_3_&_Sup",i,".jpg"), width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".bmp"){
bmp(filename = paste0("Machine_Drift_3_&_Sup",i,".bmp"), width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".png"){
png(filename = paste0("Machine_Drift_3_&_Sup",i,".png"), width = input$exportwidth, height = input$exportheight)
}
if(input$exportFormat == ".tiff"){
tiff(filename = paste0("Machine_Drift_3_&_Sup",i,".tiff"), width = input$exportwidth, height = input$exportheight)
}
}
par(mfrow = c(2,3), mar = c(3,3.8,2,2), oma=c(0,0,1,0))
for(j in (6*(i-1)+1):(6*i)){
par(mar = c(7,4.1,2.1,2.1), bg = NA)
min <- min(currentProject()$standards[[1]]$rep_dataFinale[seq(from = 1, to = length(currentProject()$flag_stand), by = 1),threeTemp[j]], na.rm = TRUE) - max(currentProject()$standards[[1]]$rep_dataFinale[(length(currentProject()$flag_stand)+1):(2*length(currentProject()$flag_stand)),threeTemp[j]], na.rm = TRUE)*3
max <- max(currentProject()$standards[[1]]$rep_dataFinale[seq(from = 1, to = length(currentProject()$flag_stand), by = 1),threeTemp[j]], na.rm = TRUE) + max(currentProject()$standards[[1]]$rep_dataFinale[(length(currentProject()$flag_stand)+1):(2*length(currentProject()$flag_stand)),threeTemp[j]], na.rm = TRUE)*3
currentProject()$PlotIC(name = currentProject()$standardsFiles, Mean = currentProject()$standards[[1]]$rep_dataFinale[seq(from = 1, to = length(currentProject()$flag_stand), by = 1),threeTemp[j]], SD = currentProject()$standards[[1]]$rep_dataFinale[(length(currentProject()$flag_stand)+1):(2*length(currentProject()$flag_stand)),threeTemp[j]],coord = X, lengthSeg = 0.1, xlim =c(min(X),max(X)),ylim=c(min, max), ylab = paste0("Cps_",currentProject()$listeElem[threeTemp[j]],"/Cps_", currentProject()$elemStand), xlab = "")
abline(a = currentProject()$regressionModel[threeTemp[j],5], b= currentProject()$regressionModel[threeTemp[j],6], col ="red", lty = 2)
mtext(side = 3, line = 1, text = currentProject()$listeElem[threeTemp[j]])
mtext(side = 1, cex = 0.7, line = 3, text = paste0("Y (Cps_",currentProject()$listeElem[threeTemp[j]],"/Cps_", currentProject()$elemStand, ") = ", round(currentProject()$regressionModel[threeTemp[j],5],3), " + X (Stand. Rank) * ", round(currentProject()$regressionModel[threeTemp[j],6],3)))
mtext(side = 1, cex = 0.7, line = 4.5, text = paste0("slope test: ", round(currentProject()$regressionModel[threeTemp[j],4], 2)))
}
title(input$standardIn, outer=TRUE, cex = 1.5)
dev.off()
}
}
if(nRest != 0){
if(is.null(input$exportFormat)){
jpeg(filename = paste0("Machine_Drift_3_&_Sup",nbGraph + 1,".jpg"), width = 760, height = 400)
} else {
if(input$exportFormat == ".jpeg"){