R/spade.R

Defines functions unformat_bubbles format_bubbles fold_change_groups_dataframe_to_list create_fold_change_groups create_spade_object

# Copyright 2020 Beckman Coulter, Inc.
# This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
# You should have received a copy of the GNU General Public License along with this program.  If not, see <https://www.gnu.org/licenses/>.

#' SPADE Endpoints
#'
#' Interact with SPADE advanced analyses using these endpoints.
#' @name spade
#' @param bubbles vector/list of characters representing bubbles within a SPADE analysis, \href{https://support.cytobank.org/hc/en-us/articles/115000600148-Analysis-and-Interpretation-of-SPADE-Results#Consolidate-Similar-Clusters-into-Bubbles}{learn more about SPADE bubbles}
#' @param directory character representing a specific directory (optional ending directory slash), default will be current working directory \strong{[optional]}
#' @param experiment_id integer representing an \link[=experiments]{experiment} ID
#' @param output character representing the output format  \strong{[optional]}\cr
#' \emph{- spade.list, spade.run, spade.status : \code{("default", "raw")}}
#' @param spade Cytobank SPADE object
#' @param spade_id integer representing a SPADE ID
#' @param spade_name character representing a new SPADE name
#' @param timeout integer representing the request timeout time in seconds  \strong{[optional]}
#' @param UserSession Cytobank UserSession object
#' @examples \dontrun{# Authenticate via username/password
#' cyto_session <- authenticate(site="premium", username="cyril_cytometry", password="cytobank_rocks!")
#' # Authenticate via auth_token
#' cyto_session <- authenticate(site="premium", auth_token="my_secret_auth_token")
#'
#' # cyto_spade refers to a SPADE object that is created from SPADE endpoints
#' #   examples: spade.new, spade.show (see details section for more)
#' }
NULL


######################
# SPADE class methods
######################


setGeneric("spade.bubbles_export", function(UserSession, spade, bubbles, output="default", timeout=UserSession@long_timeout)
{
    standardGeneric("spade.bubbles_export")
})
#' @rdname spade
#' @aliases spade.bubbles_export
#'
#' @details \code{spade.bubbles_export} Export SPADE advanced analysis bubbles from an experiment to a new experiment.
#' @examples \dontrun{spade.bubbles_export(cyto_session, spade=cyto_spade, bubbles=c("bubble1", "bubble2"))
#' }
#' @export
setMethod("spade.bubbles_export", signature(UserSession="UserSession", spade="SPADE"), function(UserSession, spade, bubbles, output="default", timeout=UserSession@long_timeout)
{
    resp <- POST(paste(UserSession@site, "/experiments/", spade@source_experiment, "/advanced_analyses/spade/", spade@spade_id, "/export_bubbles_to_new_experiment", sep=""),
                 add_headers(Authorization=paste("Bearer", UserSession@auth_token)),
                 body=list(spade=list(bubbles=bubbles)),
                 encode="json",
                 timeout(timeout)
    )

    if (output == "default")
    {
        return(cyto_dataframe(parse(resp, "SPADE")))
    }
    else # if (output == "raw")
    {
        return(parse(resp, "SPADE"))
    }
})


setGeneric("spade.bubbles_set", function(UserSession, spade, bubbles, output="default", timeout=UserSession@long_timeout)
{
    standardGeneric("spade.bubbles_set")
})
#' @rdname spade
#' @aliases spade.bubbles_set
#'
#' @details \code{spade.bubbles_set} Set SPADE advanced analysis bubbles from an experiment.
#' @examples \dontrun{named_bubble_list_of_node_vectors <- list("bubble_1"=c(1,2,4), "bubble_2"=8, "bubble_4"=c(10,12))
#' spade.bubbles_set(cyto_session, spade=cyto_spade, bubbles=named_bubble_list_of_node_vectors)
#' }
#' @export
setMethod("spade.bubbles_set", signature(UserSession="UserSession", spade="SPADE"), function(UserSession, spade, bubbles, output="default", timeout=UserSession@long_timeout)
{
    resp <- POST(paste(UserSession@site, "/experiments/", spade@source_experiment, "/advanced_analyses/spade/", spade@spade_id, "/set_bubbles", sep=""),
                 add_headers(Authorization=paste("Bearer", UserSession@auth_token)),
                 body=list(spade=list(bubbles=unformat_bubbles(bubbles))),
                 encode="json",
                 timeout(timeout)
    )

    if (output == "default")
    {
        # Format bubbles to named list of vectors
        return(format_bubbles(parse(resp, "SPADE")$spade$bubbles))
    }
    else # if (output == "raw")
    {
        return(parse(resp, "SPADE"))
    }
})


setGeneric("spade.bubbles_show", function(UserSession, spade, output="default", timeout=UserSession@short_timeout)
{
    standardGeneric("spade.bubbles_show")
})
#' @rdname spade
#' @aliases spade.bubbles_show
#'
#' @details \code{spade.bubbles_show} Show SPADE advanced analysis bubbles from an experiment.
#' @examples \dontrun{spade.bubbles_show(cyto_session, spade=cyto_spade)
#' }
#' @export
setMethod("spade.bubbles_show", signature(UserSession="UserSession", spade="SPADE"), function(UserSession, spade, output="default", timeout=UserSession@short_timeout)
{
    resp <- GET(paste(UserSession@site, "/experiments/", spade@source_experiment, "/advanced_analyses/spade/", spade@spade_id, "/show_bubbles", sep=""),
                add_headers(Authorization=paste("Bearer", UserSession@auth_token)),
                timeout(timeout)
    )

    if (output == "default")
    {
        # Format bubbles to named list of vectors
        return(format_bubbles(parse(resp, "SPADE")$spade$bubbles))
    }
    else # if (output == "raw")
    {
        return(parse(resp, "SPADE"))
    }
})


setGeneric("spade.copy_results", function(UserSession, spade, output="default", timeout=UserSession@short_timeout)
{
    standardGeneric("spade.copy_results")
})
#' @rdname spade
#' @aliases spade.copy_results
#'
#' @details \code{spade.copy_results} Copy SPADE advanced analysis results from an experiment to a new experiment.
#' @examples \dontrun{spade.copy_results(cyto_session, spade=cyto_spade)
#' }
#' @export
setMethod("spade.copy_results", signature(UserSession="UserSession", spade="SPADE"), function(UserSession, spade, output="default", timeout=UserSession@short_timeout)
{
    resp <- POST(paste(UserSession@site, "/experiments/", spade@source_experiment, "/advanced_analyses/spade/", spade@spade_id, "/copy_settings", sep=""),
                 add_headers(Authorization=paste("Bearer", UserSession@auth_token)),
                 timeout(timeout)
    )

    if (output == "default")
    {
        return(cyto_dataframe(parse(resp, "SPADE")))
    }
    else # if (output == "raw")
    {
        return(parse(resp, "SPADE"))
    }
})


setGeneric("spade.copy_settings", function(UserSession, spade, output="default", timeout=UserSession@short_timeout)
{
    standardGeneric("spade.copy_settings")
})
#' @rdname spade
#' @aliases spade.copy_settings
#'
#' @details \code{spade.copy_settings} Copy SPADE advanced analysis settings from an experiment.
#' @examples \dontrun{spade.copy_settings(cyto_session, spade=cyto_spade)
#' }
#' @export
setMethod("spade.copy_settings", signature(UserSession="UserSession", spade="SPADE"), function(UserSession, spade, output="default", timeout=UserSession@short_timeout)
{
    resp <- POST(paste(UserSession@site, "/experiments/", spade@source_experiment, "/advanced_analyses/spade/", spade@spade_id, "/copy_settings", sep=""),
                 add_headers(Authorization=paste("Bearer", UserSession@auth_token)),
                 timeout(timeout)
    )

    if (output == "default")
    {
        return(cyto_dataframe(parse(resp, "SPADE")))
    }
    else # if (output == "raw")
    {
        return(parse(resp, "SPADE"))
    }
})


setGeneric("spade.delete", function(UserSession, spade, timeout=UserSession@short_timeout)
{
    standardGeneric("spade.delete")
})
#' @rdname spade
#' @aliases spade.delete
#'
#' @details \code{spade.delete} Delete a SPADE advanced analysis from an experiment.
#' @examples \dontrun{spade.delete(cyto_session, spade=cyto_spade)
#' }
#' @export
setMethod("spade.delete", signature(UserSession="UserSession", spade="SPADE"), function(UserSession, spade, timeout=UserSession@short_timeout)
{
    resp <- DELETE(paste(UserSession@site, "/experiments/", spade@source_experiment, "/advanced_analyses/spade/", spade@spade_id, sep=""),
                   add_headers(Authorization=paste("Bearer", UserSession@auth_token)),
                   timeout(timeout)
    )

    if (http_error(resp))
    {
        error_parse(resp, "experiments")
    }

    return(paste("SPADE (ID=", spade@spade_id, ") successfully deleted.", sep=""))
})


setGeneric("spade.download_all", function(UserSession, spade, directory=getwd(), timeout=UserSession@long_timeout)
{
    standardGeneric("spade.download_all")
})
#' @rdname spade
#' @aliases spade.download_all
#'
#' @details \code{spade.download_all} Download a SPADE advanced analysis with all data included from an experiment.
#' @examples \dontrun{spade.download_all(cyto_session, spade=cyto_spade,
#'     directory="/my/new/download/directory/")
#' }
#' @export
setMethod("spade.download_all", signature(UserSession="UserSession", spade="SPADE"), function(UserSession, spade, directory=getwd(), timeout=UserSession@long_timeout)
{
    temp_directory <- directory_file_join(directory, "tmp.part")

    resp <- GET(paste(UserSession@site, "/experiments/", spade@source_experiment, "/advanced_analyses/spade/", spade@spade_id, "/download?item=full_data", sep=""),
                add_headers(Authorization=paste("Bearer", UserSession@auth_token)),
                write_disk(temp_directory, overwrite=TRUE),
                timeout(timeout)
    )

    if (http_error(resp))
    {
        error_parse(resp, "SPADE")
    }

    return(rename_temp_file(resp, directory))
})


setGeneric("spade.download_clusters_table", function(UserSession, spade, directory=getwd(), timeout=UserSession@long_timeout)
{
    standardGeneric("spade.download_clusters_table")
})
#' @rdname spade
#' @aliases spade.download_clusters_table
#'
#' @details \code{spade.download_clusters_table} Download a SPADE advanced analysis global clusters table from an experiment.
#' @examples \dontrun{spade.download_clusters_table(cyto_session, spade=cyto_spade,
#'   directory="/my/new/download/directory/")
#' }
#' @export
setMethod("spade.download_clusters_table", signature(UserSession="UserSession", spade="SPADE"), function(UserSession, spade, directory=getwd(), timeout=UserSession@long_timeout)
{
    temp_directory <- directory_file_join(directory, "tmp.part")

    resp <- GET(paste(UserSession@site, "/experiments/", spade@source_experiment, "/advanced_analyses/spade/", spade@spade_id, "/download?item=clusters_table", sep=""),
                add_headers(Authorization=paste("Bearer", UserSession@auth_token)),
                write_disk(temp_directory, overwrite=TRUE),
                timeout(timeout)
    )

    if (http_error(resp))
    {
        error_parse(resp, "SPADE")
    }

    return(rename_temp_file(resp, directory))
})


setGeneric("spade.download_global_boundaries_table", function(UserSession, spade, directory=getwd(), timeout=UserSession@long_timeout)
{
    standardGeneric("spade.download_global_boundaries_table")
})
#' @rdname spade
#' @aliases spade.download_global_boundaries_table
#'
#' @details \code{spade.download_global_boundaries_table} Download a SPADE advanced analysis global boundaries table from an experiment.
#' @examples \dontrun{spade.download_global_boundaries_table(cyto_session,
#'   spade=cyto_spade, directory="/my/new/download/directory/")
#' }
#' @export
setMethod("spade.download_global_boundaries_table", signature(UserSession="UserSession", spade="SPADE"), function(UserSession, spade, directory=getwd(), timeout=UserSession@long_timeout)
{
    temp_directory <- directory_file_join(directory, "tmp.part")

    resp <- GET(paste(UserSession@site, "/experiments/", spade@source_experiment, "/advanced_analyses/spade/", spade@spade_id, "/download?item=global_boundaries_table", sep=""),
                add_headers(Authorization=paste("Bearer", UserSession@auth_token)),
                write_disk(temp_directory, overwrite=TRUE),
                timeout(timeout)
    )

    if (http_error(resp))
    {
        error_parse(resp, "SPADE")
    }

    return(rename_temp_file(resp, directory))
})


setGeneric("spade.download_gml", function(UserSession, spade, directory=getwd(), timeout=UserSession@long_timeout)
{
    standardGeneric("spade.download_gml")
})
#' @rdname spade
#' @aliases spade.download_gml
#'
#' @details \code{spade.download_gml} Download a SPADE advanced analysis GML from an experiment.
#' @examples \dontrun{spade.download_gml(cyto_session, spade=cyto_spade,
#'     directory="/my/new/download/directory/")
#' }
#' @export
setMethod("spade.download_gml", signature(UserSession="UserSession", spade="SPADE"), function(UserSession, spade, directory=getwd(), timeout=UserSession@long_timeout)
{
    temp_directory <- directory_file_join(directory, "tmp.part")

    resp <- GET(paste(UserSession@site, "/experiments/", spade@source_experiment, "/advanced_analyses/spade/", spade@spade_id, "/download?item=gml", sep=""),
                add_headers(Authorization=paste("Bearer", UserSession@auth_token)),
                write_disk(temp_directory, overwrite=TRUE),
                timeout(timeout)
    )

    if (http_error(resp))
    {
        error_parse(resp, "SPADE")
    }

    return(rename_temp_file(resp, directory))
})


setGeneric("spade.download_layout_table", function(UserSession, spade, directory=getwd(), timeout=UserSession@long_timeout)
{
    standardGeneric("spade.download_layout_table")
})
#' @rdname spade
#' @aliases spade.download_layout_table
#'
#' @details \code{spade.download_layout_table} Download a SPADE advanced analysis layout table from an experiment.
#' @examples \dontrun{spade.download_layout_table(cyto_session, spade=cyto_spade,
#'     directory="/my/new/download/directory/")
#' }
#' @export
setMethod("spade.download_layout_table", signature(UserSession="UserSession", spade="SPADE"), function(UserSession, spade, directory=getwd(), timeout=UserSession@long_timeout)
{
    temp_directory <- directory_file_join(directory, "tmp.part")

    resp <- GET(paste(UserSession@site, "/experiments/", spade@source_experiment, "/advanced_analyses/spade/", spade@spade_id, "/download?item=layout_table", sep=""),
                add_headers(Authorization=paste("Bearer", UserSession@auth_token)),
                write_disk(temp_directory, overwrite=TRUE),
                timeout(timeout)
    )

    if (http_error(resp))
    {
        error_parse(resp, "SPADE")
    }

    return(rename_temp_file(resp, directory))
})


setGeneric("spade.download_statistics_tables", function(UserSession, spade, directory=getwd(), timeout=UserSession@long_timeout)
{
    standardGeneric("spade.download_statistics_tables")
})
#' @rdname spade
#' @aliases spade.download_statistics_tables
#'
#' @details \code{spade.download_statistics_tables} Download a SPADE advanced analysis statistics table from an experiment.
#' @examples \dontrun{spade.download_statistics_tables(cyto_session, spade=cyto_spade,
#'   directory="/my/new/download/directory/")
#' }
#' @export
setMethod("spade.download_statistics_tables", signature(UserSession="UserSession", spade="SPADE"), function(UserSession, spade, directory=getwd(), timeout=UserSession@long_timeout)
{
    temp_directory <- directory_file_join(directory, "tmp.part")

    resp <- GET(paste(UserSession@site, "/experiments/", spade@source_experiment, "/advanced_analyses/spade/", spade@spade_id, "/download?item=statistics_table", sep=""),
                add_headers(Authorization=paste("Bearer", UserSession@auth_token)),
                write_disk(temp_directory, overwrite=TRUE),
                timeout(timeout)
    )

    if (http_error(resp))
    {
        error_parse(resp, "SPADE")
    }

    return(rename_temp_file(resp, directory))
})


setGeneric("spade.list", function(UserSession, experiment_id, output="default", timeout=UserSession@short_timeout)
{
    standardGeneric("spade.list")
})
#' @rdname spade
#' @aliases spade.list
#'
#' @details \code{spade.list} List all SPADE advanced analyses from an experiment. Outputs a dataframe [default] or list with all fields present.\cr
#' \emph{- Optional output parameter, specify one of the following: \code{("default", "raw")}}
#' @examples \dontrun{# Dataframe of all SPADE advanced analyses with all fields present
#' spade.list(cyto_session, 22)
#'
#' # Raw list of all SPADE advanced analyses with all fields present
#' spade.list(cyto_session, 22, output="raw")
#' }
#' @export
setMethod("spade.list", signature(UserSession="UserSession"), function(UserSession, experiment_id, output="default", timeout=UserSession@short_timeout)
{
    output_check(output, "SPADE", possible_outputs=c("raw"))

    resp <- GET(paste(UserSession@site, "/experiments/", experiment_id, "/advanced_analyses/spade", sep=""),
                add_headers(Authorization=paste("Bearer", UserSession@auth_token)),
                timeout(timeout)
    )

    if (output == "default")
    {
        return(cyto_dataframe(parse(resp, "SPADE")$spade))
    }
    else # if (output == "raw")
    {
        return(parse(resp, "SPADE"))
    }
})


setGeneric("spade.new", function(UserSession, experiment_id, spade_name, timeout=UserSession@long_timeout)
{
    standardGeneric("spade.new")
})
#' @rdname spade
#' @aliases spade.new
#'
#' @details \code{spade.new} Create a new SPADE advanced analysis from an experiment and returns a SPADE object.
#' @examples \dontrun{spade.new(cyto_session, 22, spade_name="My new SPADE analysis")
#' }
#' @export
setMethod("spade.new", signature(UserSession="UserSession"), function(UserSession, experiment_id, spade_name, timeout=UserSession@long_timeout)
{
    resp <- POST(paste(UserSession@site, "/experiments/", experiment_id, "/advanced_analyses/spade/", sep=""),
                 add_headers(Authorization=paste("Bearer", UserSession@auth_token)),
                 body=list(spade=list(name=spade_name)),
                 encode="json",
                 timeout(timeout)
    )

    return(create_spade_object(UserSession, parse(resp, "SPADE")))
})


setGeneric("spade.rename", function(UserSession, spade, spade_name, timeout=UserSession@short_timeout)
{
    standardGeneric("spade.rename")
})
#' @rdname spade
#' @aliases spade.rename
#'
#' @details \code{spade.rename} Rename a SPADE advanced analysis from an experiment and returns a SPADE object.
#' @examples \dontrun{spade.rename(cyto_session, spade=cyto_spade, spade_name="My updated SPADE name")
#' }
#' @export
setMethod("spade.rename", signature(UserSession="UserSession", spade="SPADE"), function(UserSession, spade, spade_name, timeout=UserSession@short_timeout)
{
    resp <- PUT(paste(UserSession@site, "/experiments/", spade@source_experiment, "/advanced_analyses/spade/", spade@spade_id, "/rename", sep=""),
                add_headers(Authorization=paste("Bearer", UserSession@auth_token)),
                body=list(spade=list(name=spade_name)),
                encode="json",
                timeout(timeout)
    )

    spade@name <- parse(resp, "SPADE")$name
    return(spade)
})


setGeneric("spade.run", function(UserSession, spade, output="default", timeout=UserSession@long_timeout)
{
    standardGeneric("spade.run")
})
#' @rdname spade
#' @aliases spade.run
#'
#' @details \code{spade.run} Run a SPADE advanced analysis from an experiment.
#' @examples \dontrun{spade.run(cyto_session, spade=cyto_spade)
#' }
#' @export
setMethod("spade.run", signature(UserSession="UserSession", spade="SPADE"), function(UserSession, spade, output="default", timeout=UserSession@long_timeout)
{
    output_check(output, "SPADE", possible_outputs=c("raw"))

    resp <- POST(paste(UserSession@site, "/experiments/", spade@source_experiment, "/advanced_analyses/spade/", spade@spade_id, "/run", sep=""),
                 add_headers(Authorization=paste("Bearer", UserSession@auth_token)),
                 timeout(timeout)
    )

    if (output == "default")
    {
        return(cyto_dataframe(parse(resp, "SPADE")))
    }
    else # if (output == "raw")
    {
        return(parse(resp, "SPADE"))
    }
})


setGeneric("spade.show", function(UserSession, experiment_id, spade_id, timeout=UserSession@short_timeout)
{
    standardGeneric("spade.show")
})
#' @rdname spade
#' @aliases spade.show
#'
#' @details \code{spade.show} Show SPADE advanced analysis details from an experiment and returns a SPADE object.
#' @examples \dontrun{spade.show(cyto_session, 22, spade_id=2)
#' }
#' @export
setMethod("spade.show", signature(UserSession="UserSession"), function(UserSession, experiment_id, spade_id, timeout=UserSession@short_timeout)
{
    resp <- GET(paste(UserSession@site, "/experiments/", experiment_id, "/advanced_analyses/spade/", spade_id, "?include_settings=1", sep=""),
                add_headers(Authorization=paste("Bearer", UserSession@auth_token)),
                timeout(timeout)
    )

    return(create_spade_object(UserSession, parse(resp, "SPADE")))
})


setGeneric("spade.status", function(UserSession, spade, output="default", timeout=UserSession@long_timeout)
{
    standardGeneric("spade.status")
})
#' @rdname spade
#' @aliases spade.status
#'
#' @details \code{spade.status} Show the status of a SPADE advanced analysis from an experiment.
#' @examples \dontrun{spade.status(cyto_session, spade=cyto_spade)
#' }
#' @export
setMethod("spade.status", signature(UserSession="UserSession", spade="SPADE"), function(UserSession, spade, output="default", timeout=UserSession@long_timeout)
{
    output_check(output, "SPADE", possible_outputs=c("raw"))

    resp <- GET(paste(UserSession@site, "/experiments/", spade@source_experiment, "/advanced_analyses/spade/", spade@spade_id, "/status", sep=""),
                add_headers(Authorization=paste("Bearer", UserSession@auth_token)),
                timeout(timeout)
    )

    if (output == "default")
    {
        return(cyto_dataframe(parse(resp, "SPADE")))
    }
    else # if (output == "raw")
    {
        return(parse(resp, "SPADE"))
    }
})


setGeneric("spade.update", function(UserSession, spade, timeout=UserSession@long_timeout)
{
    standardGeneric("spade.update")
})
#' @rdname spade
#' @aliases spade.update
#'
#' @details \code{spade.update} Update a SPADE advanced analysis from an experiment and returns the new SPADE object.
#' @examples \dontrun{spade.update(cyto_session, spade=cyto_spade)
#' }
#' @export
setMethod("spade.update", signature(UserSession="UserSession", spade="SPADE"), function(UserSession, spade, timeout=UserSession@long_timeout)
{
    # Convert fold change groups dataframe -> list readable by update endpoint
    fold_change_groups <- fold_change_groups_dataframe_to_list(spade@fold_change_groups)

    if (length(spade@channels) && is.character(spade@channels[[1]]))
    {
        spade@channels <- as.list(helper.channel_ids_from_long_names(spade@.available_channels, spade@channels))
    }

    down_sampling <- list()
    if (spade@down_sampled_events_type=="percent")
    {
        down_sampling <- list(percent=spade@down_sampled_events_target)
    }
    else if (spade@down_sampled_events_type=="absolute_number")
    {
        down_sampling <- list(absoluteNumber=spade@down_sampled_events_target)
    }
    else
    {
        stop(
            paste("Cytobank API 'spade.update' request failed [client]\n    Please provide a valid 'down_sampled_events_type' argument\n    - percent\n    - absolute_number\n", sep="")
        )
    }

    resp <- PUT(paste(UserSession@site, "/experiments/", spade@source_experiment, "/advanced_analyses/spade/", spade@spade_id, sep=""),
                add_headers(Authorization=paste("Bearer", UserSession@auth_token)),
                body=list(spade=list(
                    name=spade@name,
                    compensationId=spade@compensation_id,
                    targetNumberOfNodes=spade@target_number_nodes,
                    population=spade@population_id,
                    clusteringChannels=spade@channels,
                    downSampledEventsTarget=down_sampling,
                    foldChangeGroups=fold_change_groups
                )
                ),
                encode="json",
                timeout(timeout)
    )

    return(create_spade_object(UserSession, parse(resp, "SPADE")))
})


#########################
# SPADE HELPER FUNCTIONS
#########################


##########
# PRIVATE
##########


# Create SPADE object from SPADE json response
create_spade_object <- function(UserSession, spade_response)
{
    return(
        new("SPADE", name=spade_response$spade$name,
            target_number_nodes=spade_response$spade$settings$targetNumberOfNodes,
            population_id=spade_response$spade$settings$population,
            down_sampled_events_target=spade_response$spade$settings$downSampledEventsTarget[[1]],
            down_sampled_events_type=names(spade_response$spade$settings$downSampledEventsTarget),
            fold_change_groups=create_fold_change_groups(spade_response$spade$settings$foldChangeGroups),
            spade_id=spade_response$spade$id,
            channels=spade_response$spade$settings$clusteringChannels,
            compensation_id=spade_response$spade$settings$compensation,
            source_experiment=spade_response$spade$sourceExperiment,
            created_experiment=if (!is.null(spade_response$spade$createdExperiment)) spade_response$spade$createdExperiment else NA_integer_,
            status=spade_response$spade$status,
            .available_channels=panels.list(UserSession, spade_response$spade$sourceExperiment),
            .available_files=fcs_files.list(UserSession, spade_response$spade$sourceExperiment),
            .available_populations=populations.list(UserSession, spade_response$spade$sourceExperiment))
    )
}


# Converts fold change groups output -> fold change groups dataframe
create_fold_change_groups <- function(fold_change_groups_output)
{
    fold_change_groups_list <- list()

    # for each group
    for (group in fold_change_groups_output)
    {
        # Create a dataframe
        temp_data <- do.call(rbind.data.frame, group[[2]])
        temp_data["name"] <- lapply(temp_data["name"], as.character) # Convert 'names' as factors -> characters
        # Add group name to group
        temp_data$group_name <- apply(temp_data, 1, function(row) group[[1]])
        fold_change_groups_list <- c(fold_change_groups_list, list(temp_data))
    }

    # Combine and return one dataframe of fold change group data
    return(do.call(rbind, fold_change_groups_list))
}


# Convert fold change groups dataframe -> fold change groups list for update
fold_change_groups_dataframe_to_list <- function(fold_change_groups_dataframe)
{
    # Dataframe -> list with group[fcs_files]
    fold_change_groups_list <- list()
    for (x in seq(nrow(fold_change_groups_dataframe)))
    {
        fold_change_groups_list[[fold_change_groups_dataframe$group_name[[x]]]]$fcsFiles <- c(
            fold_change_groups_list[[fold_change_groups_dataframe$group_name[[x]]]]$fcsFiles,
            list(list(id=fold_change_groups_dataframe$id[[x]],
                      baseline=fold_change_groups_dataframe$baseline[[x]])
            )
        )
    }

    # group[fcs_files] -> [group, fcs_files]
    fold_change_groups <- list()
    for (group in names(fold_change_groups_list))
    {
        fold_change_groups <- c(fold_change_groups, list(list(name=group, fcsFiles=fold_change_groups_list[[group]]$fcsFiles)))
    }

    return(fold_change_groups)
}


# Format bubbles output from spade.bubbles_show
format_bubbles <- function(spade_bubbles)
{
    bubble_list <- list()
    for (bubble in spade_bubbles)
    {
        for (node in bubble[["nodes"]])
        {
            bubble_list[[bubble[["name"]]]] <- c(bubble_list[[bubble[["name"]]]], node)
        }
    }

    return(bubble_list)
}


# Unformat formatted bubbles output from spade.bubbles_show
unformat_bubbles <- function(spade_bubbles)
{
    bubble_list <- list()
    for (bubble in names(spade_bubbles))
    {
        bubble_list <- c(bubble_list, list(list(name=bubble, nodes=as.list(spade_bubbles[[bubble]]))))
    }

    return(bubble_list)
}

Try the CytobankAPI package in your browser

Any scripts or data that you put into this service are public.

CytobankAPI documentation built on April 21, 2023, 9:08 a.m.