R/server_functions.R

In FastqCleaner: A Shiny Application for Quality Control, Filtering and Trimming of FASTQ Files

#' check onclick
#' @description Function to put a tickmark on click
#' @return Change value of reactive output, without return 
#' @keywords internal

check_onclick_ <- function(.menu_react, .butt_number, my_envir) {

output <- NULL

check_onclick <- function(menu_react, butt_number) {
element <- paste0("check", butt_number)
output[[element]] <- shiny::renderPrint({
    if (menu_react() == TRUE) {
        shiny::HTML(paste0("<script>
        \t\t\t\t\t   $(\"#button", 
        butt_number, " span\").addClass(\"checked\");
        \t\t\t\t\t   </script>"))
    } else {
        shiny::HTML(paste0("<script>
        \t\t\t\t\t   if($(\"#button", 
        butt_number, " span\").hasClass(\"checked\")) {
        \t\t\t\t\t   $(\"#button", 
        butt_number, " span\").removeClass(\"checked\");}
        \t\t\t\t\t   
        \t\t\t\t\t   </script>"))
    }
})
}
environment(check_onclick) <- my_envir
check_onclick(.menu_react, .butt_number)
}

#' outputClean_
#' @return Vector with chunks length and width  information 
#' @keywords internal

outputClean_ <- function(.myFile, .lengthWidthVec, my_envir) {

outputClean <- function(myFile, lengthWidthVec) {
file_length <- length(myFile)
file_width <- Biostrings::width(ShortRead::sread(myFile))
lengthWidthVec[[1]] <- sum(c(lengthWidthVec[[1]], file_length))
lengthWidthVec[[2]] <- unique(c(lengthWidthVec[[2]], file_width))
if (length(lengthWidthVec[[2]]) > 1) {
    lengthWidthVec[[2]] <- c(min(lengthWidthVec[[2]]), 
    max(lengthWidthVec[[2]]))
}
lengthWidthVec
}
environment(outputClean) <- my_envir
outputClean(.myFile, .lengthWidthVec)
}

#' messageFun_
#' @return Changes the state of reactive vector, without return 
#' @keywords internal


messageFun_ <- function(.who, .chunck, .which_read, my_envir) {
messageFun <- function(who, chunck, which_read, envir) {

readsWidth[[who]][[which_read]] <- outputClean_(chunck, 
readsWidth[[who]][[which_read]], envir)
chunck_length <- readsWidth[[who]][[which_read]][[1]]
chunck_width <- readsWidth[[who]][[which_read]][[2]]
if (length(chunck_width) > 1) {
    chunck_width <- paste0(min(chunck_width), "-", 
    max(chunck_width), " cicles")
} else {
    chunck_width <- paste0(readsWidth[[who]][[which_read]][[2]], 
    " cicles")
}
messages[[who]][which_read] <- paste0("Processed: ", chunck_length, 
                                        " reads. ", 
                                        chunck_width)
}
environment(messageFun) <- my_envir
messageFun(.who, .chunck, .which_read, my_envir)
}


#' create_cleanfunction_
#' @description Create a function to process FASTQ files in function
#' of the Shiny parameters selected by the user
#' @return Function with selected cleaning operations
#' @keywords internal

create_cleanfunction_ <- function(my_envir, 
.which_read = c("FORWARD", "REVERSE")) {
.which_read <- match.arg(.which_read)
force(my_envir)  

out <- function() {}

NCleanData <- lowComplexData <- SeqInput <- function() {}
FilterbymeanQ <- TrimCleanData <- FixedCleanData <- function() {}
SizeCleanData <- FilterbymeanQ <- TrimCleanData <- function() {}
FixedCleanData <- SizeCleanData <- DuplicCleanData <- function() {}

fun_body <- function(which_read) {

if (NCleanData()) {
    e1 <- expression(fileToProcess <- n_filter(fileToProcess,
    as.numeric(input$rm.N)), 
    messageFun_("nFilterCatch", 
    fileToProcess, read, my_envir))
} else {
    e1 <- expression()
}

if (lowComplexData()) {
    e2 <- expression(fileToProcess <- complex_filter(fileToProcess,
    input$complexThres), 
    messageFun_("lowComplexFilterCatch", 
    fileToProcess, read, my_envir))
} else {
    e2 <- expression()
}

if (SeqInput()) {
    if (which_read == "FORWARD") {
        e3 <- expression(fileToProcess <- adapter_filter(fileToProcess,
            Lpattern = input$LpatternF, 
            Rpattern = input$RpatternF,
            rc.L = input$reverseLF, 
            rc.R = input$reverseRF, 
            first = input$first_forward,
            with_indels = input$indels, 
            error_rate = input$errate, 
            anchored = input$anchored, 
            min_match_flank = input$min_match_flank, 
            checks = FALSE), 
        messageFun_("seqFilterCatch", fileToProcess, 
        .which_read = 1,  my_envir))
} else {
        e3 <- expression(fileToProcess <- adapter_filter(fileToProcess, 
            Lpattern = input$LpatternR, 
            Rpattern = input$RpatternR, 
            rc.L = input$reverseLR, 
            rc.R = input$reverseRR,
            first = input$first_reverse, 
            with_indels = input$indels, 
            error_rate = input$errate,
            anchored = input$anchored,
            min_match_flank = input$min_match_flank, 
            checks = FALSE), 
        messageFun_("seqFilterCatch", fileToProcess, 
        .which_read = 2,  my_envir))
}  # end 'REVERSE'

} else {
    e3 <- expression()
}

if (FilterbymeanQ()) {
    e4 <- expression(fileToProcess <- qmean_filter(fileToProcess,
        input$thresmeanQ, 
        q_format = my_encoding[["value"]]), 
    messageFun_("meanQFilterCatch", fileToProcess, read, my_envir))
} else {
e4 <- expression()
}

if (TrimCleanData()) {
    e5 <- expression(fileToProcess <- trim3q_filter(fileToProcess, 
        input$thresQual, 
        q_format = my_encoding[["value"]]), 
        messageFun_("trim3FilterCatch", fileToProcess, read, my_envir))
} else {
e5 <- expression()
}

if (FixedCleanData()) {
    e6 <- expression(fileToProcess <- fixed_filter(fileToProcess, input$rm3, 
    input$rm5), 
    messageFun_("fixedFilterCatch", fileToProcess, read, my_envir))
} else {
    e6 <- expression()
}

if (SizeCleanData()) {
    e7 <- expression(fileToProcess <- length_filter(fileToProcess, input$rmMin, 
    input$rmMax), 
    messageFun_("lengthFilterCatch", fileToProcess, read,  my_envir))
} else {
e7 <- expression()
}

if (DuplicCleanData()) {
    e8 <- expression(fileToProcess <- unique_filter(fileToProcess),
    messageFun_("duplicFilterCatch", fileToProcess, read, my_envir))
} else {
    e8 <- expression()
}
    e9 <- expression(fileToProcess)
    as.call(c(as.name("{"), e1, e2, e3, e4, e5, e6, e7, e8, e9))
}

environment(fun_body) <- my_envir
body(out) <- fun_body(which_read = .which_read)
formals(out) <- alist(fileToProcess = , read = , my_envir = )
environment(out) <- my_envir

out
}

#' processingFunction_
#' @description This function is the core of the application. It is used 
#' for the program to process the FASTQ file/s in the environment 
#' of the Shiny app. Note that this program makes a call to
#' create_cleanfunction
#' @return Processes the input FASTQ file, without return
#' @keywords internal


processingFunction_ <- function(my_envir) {

input <- this_envir <- filepath <- session <- NULL

create_processing_function <- function() {

if (input$fileTypeOut == "fastq") {
    compress <- FALSE
} else {
    compress <- TRUE
}


i <- 0


if (input$fileTypeIn == "SR") {
    .cleanfunction <- create_cleanfunction_(this_envir, 
    .which_read = "FORWARD")
    no_output <- as.character(body(.cleanfunction))[2] == "fileToProcess"

} else {
    .cleanfunctionF <- create_cleanfunction_(this_envir, 
    .which_read = "FORWARD")
    .cleanfunctionR <- create_cleanfunction_(this_envir,
    .which_read = "REVERSE")
    no_output <- as.character(body(.cleanfunctionF))[2] == "fileToProcess"


}


if (input$fileTypeIn == "SR" && no_output) {
    outname <- sprintf("%s_out", filepath$x)
if (file.exists(outname)) {
    file.remove(outname)
}
    file.symlink(filepath$x, outname)
}

if (input$fileTypeIn == "PE" && no_output) {

    outname1 <- sprintf("%s_out", (filepath$x)[1])
    outname2 <- sprintf("%s_out", (filepath$x)[2])

if (file.exists(outname1)) {
    file.remove(outname1)
}

if (file.exists(outname2)) {
    file.remove(outname2)
}

file.symlink((filepath$x)[1], outname1)
file.symlink((filepath$x)[2], outname2)
}


if (input$fileTypeIn == "SR" && !no_output) {


if (file.exists(sprintf("%s_out", filepath$x))) {
    file.remove(sprintf("%s_out", filepath$x))
    file.create(sprintf("%s_out", filepath$x))
}

cat("Counting lines in file ...\n")
lfile <- ShortRead::countLines(filepath$x)/4
cat(lfile, "reads found\n\n")
largo <- 0L
ancho <- c(-1L, -1L)


progress <- shiny::Progress$new(session, min = 0, max = lfile)
progress$set(message = "Processing the file",
detail = "This may take a while...")

stream <- ShortRead::FastqStreamer(filepath$x, n = input$nfile)


while (TRUE) {
    passfile <- try(ShortRead::yield(stream), silent = TRUE)
    if(length(passfile) == 0) {

    if(length(unique(ancho)) > 1) {
        cycle_info <- paste0(ancho[1], "-", ancho[2], " cycles")
    } else {
        cycle_info <- paste0(unique(ancho), " cycles")
    }

messages[["outResult"]] <- paste0(largo, " reads. ", cycle_info, 
"\n",
sprintf("%s_out", (filepath$x)))

break

} else {
progress$set(value = i)
cat(i, " reads processed", "\n")
i <- i + length(passfile)

outFile <- .cleanfunction(passfile, read = 1, this_envir)
ShortRead::writeFastq(outFile, sprintf("%s_out", 
filepath$x), mode = "a", 
compress = compress)

largo <- largo + length(outFile)
ancho <- unique(range(c(ancho[ancho != -1], Biostrings::width(outFile))))
cat(ancho, "\n")

}
}

close(stream)
progress$close()
}

if (input$fileTypeIn == "PE" && !no_output) {

    cat("Counting lines in file ...\n")
    lfile <- (ShortRead::countLines((filepath$x)[1]))/4
    cat(lfile, "reads found\n\n")

    largoL <- largoR <- 0L
    anchoL <- anchoR <- c(-1L, -1L)

    for (j in filepath$x) {
        if (file.exists(sprintf("%s_out", j))) {
        file.remove(sprintf("%s_out", j))
    }
        file.create(sprintf("%s_out", j))
    }

    progress <- shiny::Progress$new(session, min = 0, max = lfile)
    progress$set(message = "Processing the file",
    detail = "This may take a while...")

    streamL <- ShortRead::FastqStreamer((filepath$x)[1], n = input$nfile)
    streamR <- ShortRead::FastqStreamer((filepath$x)[2], n = input$nfile)

    while (TRUE) {

        passfileL <- try(ShortRead::yield(streamL), silent = TRUE)
        passfileR <- try(ShortRead::yield(streamR), silent = TRUE)

        if(length(passfileL) == 0 && length(passfileR) == 0) {

            if(length(unique(anchoL)) > 1) {
                cycle_info_L <- paste0(anchoL[1], "-", anchoL[2], " cycles")
            } else {
                cycle_info_L <- paste0(unique(anchoL), " cycles")
            }

            messages[["outResult"]][1] <- paste0(largoL, " reads. ", 
                                            cycle_info_L, "\n",
            sprintf("%s_out", (filepath$x)[1]))

            if (length(unique(anchoR)) > 1) {
                cycle_info_R <- paste0(anchoR[1], "-", anchoR[2], " cycles")
            } else {
                cycle_info_R <- paste0(unique(anchoR), " cycles")
            }

            messages[["outResult"]][2] <- paste0(largoR, " reads. ", 
                                                cycle_info_R, "\n", 
            sprintf("%s_out", (filepath$x)[2]))

            break

        } else {
        progress$set(value = i)
        cat(i, " reads processed", "\n")
        i <- i + length(passfileL)

        outFileL <- .cleanfunctionF(passfileL, read = 1, this_envir)
        outFileR <- .cleanfunctionR(passfileR, read = 2, this_envir)

        inL <- ShortRead::id(passfileL)
        outL <- ShortRead::id(outFileL)
        indexL <- as.character(inL) %in% as.character(outL)
        names(indexL) <- seq(along = indexL)
        indexL <- names(indexL[indexL])

        inR <- ShortRead::id(passfileR)
        outR <- ShortRead::id(outFileR)
        indexL <- as.character(inL) %in% as.character(outL)
        names(indexR) <- seq(along = indexR)
        indexR <- names(indexR[indexR])

        indexpairL <- indexL %in% indexR
        indexpairR <- indexR %in% indexL

        outFileL <- outFileL[indexpairL]
        outFileR <- outFileR[indexpairR]

        ShortRead::writeFastq(outFileL, sprintf("%s_out", (filepath$x)[1]), 
        mode = "a", compress = compress)

        ShortRead::writeFastq(outFileR, sprintf("%s_out", (filepath$x)[2]), 
        mode = "a", compress = compress)


        largoL <- largoL + length(outFileL)
        largoR <- largoR + length(outFileR)

        anchoL <- unique(range(c(anchoL[anchoL != -1], 
                Biostrings::width(outFileL))))
        anchoR <- unique(range(c(anchoR[anchoR != -1], 
                Biostrings::width(outFileR))))

    }
    }

        close(streamL)
        close(streamR)
        progress$close()

        }
    }

environment(create_processing_function) <- my_envir
create_processing_function()
}