comparison galaxy/tools/LC-MSMS/XSeekerPreparator.R @ 20:ce94e7a141bb draft default tip

" master branch Updating"

19:2937e72e5891

}

search_tree <- function(path, target) {
    target <- tolower(target)
    for (file in list.files(path)) {
        if (is.dir(file)) {
            result <- search_tree(file.path(path, file), target)
            if (!is.null(result)) {
                return(result)
            }
        } else if (tolower(file) == target) {

    return(csv_header_translator(translator, compounds))
}

guess_translator <- function(header) {
    result <- list(
        # HMDB_ID = NULL,
        mz = NULL,
        name = NULL,
        common_name = NULL,
        formula = NULL,
        # inchi_key = NULL
    )
    asked_cols <- names(result)
    for (asked_col in asked_cols) {
        for (col in header) {
            if ((twisted <- tolower(col)) == asked_col

    )
    error <- tryCatch({
        process_sample_list(
            orm, rdata, samples,
            show_percent = show_percent,
            file_grouping_var = options$class
        )
        NULL
    }, error = function(e) {
        message(e)
        e
    })
    if (!is.null(mzml_tmp_dir)) {
        unlink(mzml_tmp_dir, recursive = TRUE)
    }
    if (!is.null(error)) {
        stop(error)
    }
}

gather_mzml_files <- function(rdata) {
    if (is.null(rdata$singlefile)) {
        message("Extracting mxml files")

process_sample_list <- function(
    orm,
    rdata,
    sample_names,
    show_percent,
    file_grouping_var = NULL
) {
    if (is.null(file_grouping_var)) {
        file_grouping_var <- find_grouping_var(rdata$variableMetadata)
        if (is.null(file_grouping_var)) {
            stop("Malformed variableMetada.")

        }
    }

    message("Parameters from previous processes extracted.")


    indices <- as.numeric(unique(var_meta[, file_grouping_var]))
    if (any(is.null(names(singlefile)[indices]))) {
        stop(sprintf(
            paste(
                "Indices defined by grouping variable %s are not all present",
                "in singlefile names (%s).\nCannot continue. Indices: %s"
            ),
            file_grouping_var,
            paste(names(singlefile), collapse = ", "),
            paste(indices, collapse = ", ")
        ))
    }
    smol_xcms_set <- orm$smol_xcms_set()
    mz_tab_info <- new.env()
    g <- xcms::groups(xcms_set)
    mz_tab_info$group_length <- nrow(g)
    mz_tab_info$dataset_path <- xcms::filepaths(xcms_set)

    invisible(smol_xcms_set$set_raw(blogified)$save())
    smol_xcms_set_id <- smol_xcms_set$get_id()
    rm(smol_xcms_set)

    for (no in indices) {
        sample_name <- names(singlefile)[[no]]
        sample_path <- singlefile[[no]]
        if (
            is.na(no)
            || is.null(sample_path)

    next_pc_group, next_align_group
) {
    field_names <- as.list(names(orm$feature()$fields__))
    field_names[field_names == "id"] <- NULL

    features <- list()
    dummy_feature <- orm$feature()

    if (show_percent <- context$show_percent) {
        percent <- -1
        total <- nrow(var_meta)

    rows <- seq_len(nrow(var_meta))
    if (PROCESS_SMOL_BATCH) {

        rows <- rows[1:as.integer(FAST_FEATURE_RATIO / 100.0 * length(rows))]
    }
    cluster_row <- list()
    for (row in rows) {
        if (show_percent && (row / total) * 100 > percent) {
            percent <- percent + 1
            message("\r", sprintf("\r%d %%", percent), appendLF = FALSE)
        }

            dummy_feature, clusterID,
            context, curent_var_meta, next_pc_group,
            next_align_group
        )
        next_align_group <- next_align_group + 1
        features[[length(features) + 1]] <- as.list(dummy_feature, field_names)
        dummy_feature$clear()
    }
    rm(var_meta)
    message("")
    message("Saving features")

            cluster$set_clusterID(context$clusterID)
        }
    }
    cluster$save()
    feature$set_cluster(cluster)
    return(cluster)
}

complete_features <- function(orm, clusters, show_percent) {
    total <- length(clusters)

option_list <- list(
    optparse::make_option(
        c("-v", "--version"),
        action = "store_true",
        help = "Display this tool's version and exits"
    ),
    optparse::make_option(
        c("-i", "--input"),
        type = "character",
        help = "The rdata path to import in XSeeker"

# }


load(args$options$input, rdata <- new.env())

process_rdata(orm, rdata, args$options)

quit(status = err_code)

20:ce94e7a141bb

}

search_tree <- function(path, target) {
    target <- tolower(target)
    for (file in list.files(path)) {
        if (fs::is.dir(file)) {
            result <- search_tree(file.path(path, file), target)
            if (!is.null(result)) {
                return(result)
            }
        } else if (tolower(file) == target) {

    return(csv_header_translator(translator, compounds))
}

guess_translator <- function(header) {
    result <- list(
        mz = NULL,
        name = NULL,
        common_name = NULL,
        formula = NULL
    )
    asked_cols <- names(result)
    for (asked_col in asked_cols) {
        for (col in header) {
            if ((twisted <- tolower(col)) == asked_col

    )
    error <- tryCatch({
        process_sample_list(
            orm, rdata, samples,
            show_percent = show_percent,
            file_grouping_var = options$class,
            options = options
        )
        NULL
    }, error = function(e) {
        return(e)
    })
    if (!is.null(mzml_tmp_dir)) {
        unlink(mzml_tmp_dir, recursive = TRUE)
    }
    if (!is.null(error)) {
        stop(error)
    }
    return(!is.null(error))
}

gather_mzml_files <- function(rdata) {
    if (is.null(rdata$singlefile)) {
        message("Extracting mxml files")

process_sample_list <- function(
    orm,
    rdata,
    sample_names,
    show_percent,
    file_grouping_var = NULL,
    options = list()
) {
    if (is.null(file_grouping_var)) {
        file_grouping_var <- find_grouping_var(rdata$variableMetadata)
        if (is.null(file_grouping_var)) {
            stop("Malformed variableMetada.")

        }
    }

    message("Parameters from previous processes extracted.")

    smol_xcms_set <- orm$smol_xcms_set()
    mz_tab_info <- new.env()
    g <- xcms::groups(xcms_set)
    mz_tab_info$group_length <- nrow(g)
    mz_tab_info$dataset_path <- xcms::filepaths(xcms_set)

    invisible(smol_xcms_set$set_raw(blogified)$save())
    smol_xcms_set_id <- smol_xcms_set$get_id()
    rm(smol_xcms_set)

    for (no in seq_along(names(singlefile))) {
        sample_name <- names(singlefile)[[no]]
        sample_path <- singlefile[[no]]
        if (
            is.na(no)
            || is.null(sample_path)

    next_pc_group, next_align_group
) {
    field_names <- as.list(names(orm$feature()$fields__))
    field_names[field_names == "id"] <- NULL

    dummy_feature <- orm$feature()

    if (show_percent <- context$show_percent) {
        percent <- -1
        total <- nrow(var_meta)

    rows <- seq_len(nrow(var_meta))
    if (PROCESS_SMOL_BATCH) {

        rows <- rows[1:as.integer(FAST_FEATURE_RATIO / 100.0 * length(rows))]
    }
    # features <- list()
    features <- as.list(rows) ## allocate all memory before processing
    # cluster_row <- list()
    cluster_row <- as.list(rows) ## allocate all memory before processing
    for (row in rows) {
        if (show_percent && (row / total) * 100 > percent) {
            percent <- percent + 1
            message("\r", sprintf("\r%d %%", percent), appendLF = FALSE)
        }

            dummy_feature, clusterID,
            context, curent_var_meta, next_pc_group,
            next_align_group
        )
        next_align_group <- next_align_group + 1
        features[[row]] <- as.list(dummy_feature, field_names)
        # features[[length(features) + 1]] <- as.list(dummy_feature, field_names)
        dummy_feature$clear()
    }
    rm(var_meta)
    message("")
    message("Saving features")

            cluster$set_clusterID(context$clusterID)
        }
    }
    cluster$save()
    feature$set_cluster(cluster)
    feature$save()
    return(cluster)
}

complete_features <- function(orm, clusters, show_percent) {
    total <- length(clusters)

option_list <- list(
    optparse::make_option(
        c("-v", "--version"),
        action = "store_true",
        help = "Display this tool's version and exits"
    ),
    optparse::make_option(
        c("-V", "--verbose"),
        action = "store_true",
        help = "Does more verbose outputs",
        default = FALSE
    ),
    optparse::make_option(
        c("-i", "--input"),
        type = "character",
        help = "The rdata path to import in XSeeker"

# }


load(args$options$input, rdata <- new.env())

args$options$verbose <- (
    if (args$options$verbose) {
        message("Verbose outputs.")
        \(...) {
            message(sprintf(...))
        }
    } else {
        \(...) {
        }
    }
)

err_code <- process_rdata(orm, rdata, args$options)

quit(status = err_code)