From 2fda68bef7295647af060ea8f340817efef3ef1f Mon Sep 17 00:00:00 2001 From: asizemore Date: Wed, 23 Oct 2024 18:19:37 -0400 Subject: [PATCH 1/4] add differential expression related files from microbiomeComputations --- R/class-Comparator.R | 78 ++ R/class-CountsDataCollection.R | 33 + R/method-differentialExpression.R | 319 ++++++++ .../test-method-differentialExpression.R | 697 ++++++++++++++++++ 4 files changed, 1127 insertions(+) create mode 100644 R/class-Comparator.R create mode 100644 R/class-CountsDataCollection.R create mode 100644 R/method-differentialExpression.R create mode 100644 tests/testthat/test-method-differentialExpression.R diff --git a/R/class-Comparator.R b/R/class-Comparator.R new file mode 100644 index 0000000..baaffe9 --- /dev/null +++ b/R/class-Comparator.R @@ -0,0 +1,78 @@ + +check_comparator <- function(object) { + + variable <- object@variable + groupA <- object@groupA + groupB <- object@groupB + + errors <- character() + + # Check that the variable has a reasonable variable spec + if (is.na(variable@variableSpec@variableId)) { + msg <- "Comparator variable needs a variable id" + errors <- c(errors, msg) + } + + # Check that groups exist + if (!length(groupA) || !length(groupA)) { + msg <- "Both groupA and groupB must be defined" + errors <- c(errors, msg) + } + + if (identical(variable@dataShape@value, "CONTINUOUS")) { + ## Checks for continuous variables + + # Err if variable is continuous but either group is missing a binStart or binEnd + if (!all(unlist(lapply(groupA, function(bin) {return(!!length(bin@binStart))})))) { + msg <- "All groupA bins must have a binStart" + errors <- c(errors, msg) + } + if (!all(unlist(lapply(groupA, function(bin) {return(!!length(bin@binEnd))})))) { + msg <- "All groupA bins must have a binEnd" + errors <- c(errors, msg) + } + if (!all(unlist(lapply(groupB, function(bin) {return(!!length(bin@binStart))})))) { + msg <- "All groupB bins must have a binStart" + errors <- c(errors, msg) + } + if (!all(unlist(lapply(groupB, function(bin) {return(!!length(bin@binEnd))})))) { + msg <- "All groupB bins must have a binEnd" + errors <- c(errors, msg) + } + } else { + ## Checks for non-continuous variables + + # Ensure no values are duplicated between group A and group B + groupAValues <- getGroupLabels(object, "groupA") + groupBValues <- getGroupLabels(object, "groupB") + + if (!!length(intersect(groupAValues, groupBValues))) { + msg <- "groupA and groupB cannot share members" + errors <- c(errors, msg) + } + + } + + return(if (length(errors) == 0) TRUE else errors) +} + +#' Comparator +#' +#' A class for representing a variable that will be used to compare samples between two groups. The variable's +#' values will be used to split samples into groups. +#' +#' @slot variable A VariableMetadata +#' @slot groupA BinList +#' @slot groupB BinList +#' @name Comparator-class +#' @rdname Comparator-class +#' @export +Comparator <- setClass("Comparator", representation( + variable = 'VariableMetadata', + groupA = 'BinList', + groupB = 'BinList' +), prototype = prototype( + variable = new("VariableMetadata"), + groupA = new("BinList"), + groupB = new("BinList") +), validity = check_comparator) \ No newline at end of file diff --git a/R/class-CountsDataCollection.R b/R/class-CountsDataCollection.R new file mode 100644 index 0000000..9dd8be8 --- /dev/null +++ b/R/class-CountsDataCollection.R @@ -0,0 +1,33 @@ +check_count_data_collection <- function(object) { + errors <- character() + df <- object@data + record_id_col <- object@recordIdColumn + ancestor_id_cols <- object@ancestorIdColumns + all_id_cols <- c(record_id_col, ancestor_id_cols) + + numeric_data <- df[, !(names(df) %in% all_id_cols)] + if (inherits(df, 'data.table')) numeric_data <- df[, !(names(df) %in% all_id_cols), with=F] + + if (!identical(numeric_data, round(numeric_data))) { + msg <- "Absolute abundance data must be integer numbers." + errors <- c(errors, msg) + } + + + return(if (length(errors) == 0) TRUE else errors) +} + +#' Counts Data +#' +#' A class for working with count data, including microbial or genetic assays. +#' +#' @slot data A data.frame of integer abundance counts with genes (species, etc.) as columns and samples as rows +#' @slot sampleMetadata A data.frame of metadata about the samples with samples as rows and metadata variables as columns +#' @slot recordIdColumn The name of the column containing IDs for the samples. All other columns will be treated as abundance values. +#' @slot ancestorIdColumns A character vector of column names representing parent entities of the recordIdColumn. +#' @slot imputeZero A logical indicating whether NA/ null values should be replaced with zeros. +#' @name CountDataCollection-class +#' @rdname CountDataCollection-class +#' @include class-CollectionWithMetadata.R +#' @export +CountDataCollection <- setClass("CountDataCollection", contains = "CollectionWithMetadata", validity = check_count_data_collection) \ No newline at end of file diff --git a/R/method-differentialExpression.R b/R/method-differentialExpression.R new file mode 100644 index 0000000..300ccf0 --- /dev/null +++ b/R/method-differentialExpression.R @@ -0,0 +1,319 @@ +# a helper, to reuse and separate some logic +cleanComparatorVariable <- function(data, comparator, verbose = c(TRUE, FALSE)) { + if (!inherits(data, 'AbundanceData')) stop("data must be of the AbundanceData class.") + if (!inherits(comparator, 'Comparator')) stop("comparator must be of the Comparator class.") + + comparatorColName <- veupathUtils::getColName(comparator@variable@variableSpec) + data <- removeIncompleteSamples(data, comparatorColName, verbose) + abundances <- getAbundances(data, verbose = verbose) + sampleMetadata <- getSampleMetadata(data) + recordIdColumn <- data@recordIdColumn + + veupathUtils::logWithTime(paste("Received abundance table with", nrow(abundances), "samples and", (ncol(abundances)-1), "taxa."), verbose) + + # Subset to only include samples with metadata defined in groupA and groupB + if (identical(comparator@variable@dataShape@value, "CONTINUOUS")) { + + # Ensure bin starts and ends are numeric + comparator@groupA <- as.numeric(comparator@groupA) + comparator@groupB <- as.numeric(comparator@groupB) + + + # We need to turn the numeric comparison variable into a categorical one with those values + # that fall within group A or group B bins marked with some string we know. + + # Collect all instances where the comparatorColName has values in the bins from each group. + # So inGroupA is a vector with 0 if the value in comparatorColName is not within any of the group A bins and >0 otherwise. + inGroupA <- veupathUtils::whichValuesInBinList(sampleMetadata[[comparatorColName]], comparator@groupA) + inGroupB <- veupathUtils::whichValuesInBinList(sampleMetadata[[comparatorColName]], comparator@groupB) + + # Eventually move this check to Comparator validation. See #47 + if ((any(inGroupA * inGroupB) > 0)) { + stop("Group A and Group B cannot have overlapping bins.") + } + + # Make the comparatorColName a character vector and replace the in-group values with a bin. + sampleMetadata[, (comparatorColName) := as.character(get(comparatorColName))] + + # Now we can reassign groupA and groupB and can replace values in sampleMetadata our new group values + # We don't care about the values in the comparisonVariable column anymore. They were only + # useful to help us assign groups. + sampleMetadata[inGroupA, c(comparatorColName)] <- "groupA" + sampleMetadata[inGroupB, c(comparatorColName)] <- "groupB" + + # Finally, subset the sampleMetadata to only include those samples in groupA or B + sampleMetadata <- sampleMetadata[get(comparatorColName) %in% c("groupA", "groupB"), ] + + } else { + # The comparator must be ordinal, binary, or categorical + groupAValues <- getGroupLabels(comparator, "groupA") + groupBValues <- getGroupLabels(comparator, "groupB") + + # Filter sampleMetadata to keep only those samples that are labeled as groupA or groupB. Filter + # data *before* reassigning values to 'groupA' and 'groupB' to avoid issues with the original variable + # value being 'groupA' or 'groupB' + sampleMetadata <- sampleMetadata[get(comparatorColName) %in% c(groupAValues, groupBValues), ] + + # Turn comparatorColName into a binary variable + sampleMetadata[get(comparatorColName) %in% groupAValues, c(comparatorColName)] <- 'groupA' + sampleMetadata[get(comparatorColName) %in% groupBValues, c(comparatorColName)] <- 'groupB' + } + + # sampleMetadata has already been filtered so it now only contains the samples we care about + keepSamples <- sampleMetadata[[recordIdColumn]] + if (!length(keepSamples)) { + stop("No samples remain after subsetting based on the comparator variable.") + } + # need to make sure we actually have two groups + if (length(unique(sampleMetadata[[comparatorColName]])) < 2) { + stop("The comparator variable must have at least two values/ groups within the subset.") + } + veupathUtils::logWithTime(paste0("Found ",length(keepSamples)," samples with a value for ", comparatorColName, " in either groupA or groupB. The calculation will continue with only these samples."), verbose) + + # Subset the abundance data based on the kept samples + abundances <- abundances[get(recordIdColumn) %in% keepSamples, ] + + data@data <- abundances + data@sampleMetadata <- SampleMetadata( + data = sampleMetadata, + recordIdColumn = data@sampleMetadata@recordIdColumn + ) + validObject(data) + + return(data) +} + +#' @export +DifferentialAbundanceResult <- setClass("DifferentialAbundanceResult", representation( + effectSizeLabel = 'character', + statistics = 'data.frame', + pValueFloor = 'numeric', + adjustedPValueFloor = 'numeric' +), prototype = prototype( + effectSizeLabel = 'log2(Fold Change)', + statistics = data.frame(effectSize = numeric(0), + pValue = numeric(0), + adjustedPValue = numeric(0), + pointID = character(0)) +)) + + +setGeneric("deseq", + function(data, comparator, verbose = c(TRUE, FALSE)) standardGeneric("deseq"), + signature = c("data", "comparator") +) + +setMethod("deseq", signature("AbsoluteAbundanceData", "Comparator"), function(data, comparator, verbose = c(TRUE, FALSE)) { + recordIdColumn <- data@recordIdColumn + ancestorIdColumns <- data@ancestorIdColumns + allIdColumns <- c(recordIdColumn, ancestorIdColumns) + sampleMetadata <- getSampleMetadata(data) + comparatorColName <- veupathUtils::getColName(comparator@variable@variableSpec) + + # First, remove id columns and any columns that are all 0s. + cleanedData <- purrr::discard(data@data[, -..allIdColumns], function(col) {identical(union(unique(col), c(0, NA)), c(0, NA))}) + # Next, transpose abundance data to get a counts matrix with taxa as rows and samples as columns + counts <- data.table::transpose(cleanedData) + rownames(counts) <- names(cleanedData) + colnames(counts) <- data@data[[recordIdColumn]] + + # Then, format metadata. Recall samples are rows and variables are columns + rownames(sampleMetadata) <- sampleMetadata[[recordIdColumn]] + + # Finally, check to ensure samples are in the same order in counts and metadata. Both DESeq + # and ANCOMBC expect the order to match, and will not perform this check. + if (!identical(rownames(sampleMetadata), colnames(counts))){ + # Reorder sampleMetadata to match counts + veupathUtils::logWithTime("Sample order differs between data and metadata. Reordering data based on the metadata sample order.", verbose) + data.table::setcolorder(counts, rownames(sampleMetadata)) + } + + deseq_output <- try({ + + # Create DESeqDataSet (dds) + dds <- DESeq2::DESeqDataSetFromMatrix(countData = counts, + colData = sampleMetadata, + design = as.formula(paste0("~",comparatorColName)), + tidy = FALSE) + + # Estimate size factors before running deseq to avoid errors about 0 counts + geoMeans = apply(DESeq2::counts(dds), 1, function(x){exp(sum(log(x[x > 0]), na.rm=T) / length(x))}) + dds <- DESeq2::estimateSizeFactors(dds, geoMeans = geoMeans) + + # Run DESeq + deseq_output <- DESeq2::DESeq(dds) + }) + + if (veupathUtils::is.error(deseq_output)) { + veupathUtils::logWithTime(paste0('Differential abundance FAILED with parameters recordIdColumn=', recordIdColumn, ', method = DESeq', ', verbose =', verbose), verbose) + stop() + } + + # Extract deseq results + deseq_results <- DESeq2::results(deseq_output) + + # Format results for easier access + statistics <- data.frame(effectSize = deseq_results$log2FoldChange, + pValue = deseq_results$pvalue, + adjustedPValue = deseq_results$padj, + pointID = rownames(counts)) + + result <- DifferentialAbundanceResult('effectSizeLabel' = 'log2(Fold Change)', 'statistics' = statistics) + + return(result) +}) + +setMethod("deseq", signature("AbundanceData", "Comparator"), function(data, comparator, verbose = c(TRUE, FALSE)) { + stop("Please use the AbsoluteAbundanceData class with DESeq2.") +}) + +setGeneric("maaslin", + function(data, comparator, verbose = c(TRUE, FALSE)) standardGeneric("maaslin"), + signature = c("data", "comparator") +) + +# this leaves room for us to grow into dedicated params (normalization and analysis method etc) for counts if desired +setMethod("maaslin", signature("AbundanceData", "Comparator"), function(data, comparator, verbose = c(TRUE, FALSE)) { + recordIdColumn <- data@recordIdColumn + ancestorIdColumns <- data@ancestorIdColumns + allIdColumns <- c(recordIdColumn, ancestorIdColumns) + sampleMetadata <- getSampleMetadata(data) + comparatorColName <- veupathUtils::getColName(comparator@variable@variableSpec) + abundances <- data@data + + # First, remove id columns and any columns that are all 0s. + cleanedData <- purrr::discard(abundances[, -..allIdColumns], function(col) {identical(union(unique(col), c(0, NA)), c(0, NA))}) + rownames(cleanedData) <- abundances[[recordIdColumn]] + rownames(sampleMetadata) <- sampleMetadata[[recordIdColumn]] + + maaslinOutput <- Maaslin2::Maaslin2( + input_data = cleanedData, + input_metadata = sampleMetadata, + output = tempfile("maaslin"), + #min_prevalence = 0, + fixed_effects = c(comparatorColName), + analysis_method = "LM", # default LM + normalization = "TSS", # default TSS + transform = "LOG", # default LOG + plot_heatmap = F, + plot_scatter = F) + + # NOTE!!!! Coefficient in place of Log2FC only makes sense for LM + # see https://forum.biobakery.org/t/trying-to-understand-coef-column-and-how-to-convert-it-to-fold-change/3136/8 + + statistics <- data.frame(effectSize = maaslinOutput$results$coef, + pValue = maaslinOutput$results$pval, + adjustedPValue = maaslinOutput$results$qval, + pointID = maaslinOutput$results$feature) + + result <- DifferentialAbundanceResult('effectSizeLabel' = 'Model Coefficient (Effect Size)', 'statistics' = statistics) + + return(result) +}) + +#' Differential abundance +#' +#' This function returns the fold change and associated p value for a differential abundance analysis comparing samples in two groups. +#' +#' @param data AbsoluteAbundanceData object +#' @param comparator Comparator object specifying the variable and values or bins to be used in dividing samples into groups. +#' @param method string defining the the differential abundance method. Accepted values are 'DESeq2' and 'Maaslin2'. +#' @param pValueFloor numeric value that indicates the smallest p value that should be returned. +#' The corresponding adjusted p value floor will also be updated based on this value, and will be set to the maximum adjusted p value of all floored p values. +#' The default value uses the P_VALUE_FLOOR=1e-200 constant defined in this package. +#' @param verbose boolean indicating if timed logging is desired +#' @return ComputeResult object +#' @import veupathUtils +#' @import data.table +#' @import DESeq2 +#' @importFrom Maaslin2 Maaslin2 +#' @importFrom purrr none +#' @importFrom purrr discard +# ' @useDynLib microbiomeComputations ANN WHAT DOES THIS MEAN +#' @export +setGeneric("differentialAbundance", + function(data, comparator, method = c('DESeq', 'Maaslin'), pValueFloor = P_VALUE_FLOOR, verbose = c(TRUE, FALSE)) standardGeneric("differentialAbundance"), + signature = c("data", "comparator") +) + +# this is consistent regardless of rel vs abs abund. the statistical methods will differ depending on that. +#'@export +setMethod("differentialAbundance", signature("AbundanceData", "Comparator"), function(data, comparator, method = c('DESeq', 'Maaslin'), pValueFloor = P_VALUE_FLOOR, verbose = c(TRUE, FALSE)) { + data <- cleanComparatorVariable(data, comparator, verbose) + recordIdColumn <- data@recordIdColumn + ancestorIdColumns <- data@ancestorIdColumns + allIdColumns <- c(recordIdColumn, ancestorIdColumns) + comparatorColName <- veupathUtils::getColName(comparator@variable@variableSpec) + + ## Initialize and check inputs + method <- veupathUtils::matchArg(method) + verbose <- veupathUtils::matchArg(verbose) + + + ## Compute differential abundance + if (identical(method, 'DESeq')) { + statistics <- deseq(data, comparator, verbose) +# } else if (identical(method, 'ANCOMBC')) { +# +# se <- TreeSummarizedExperiment::TreeSummarizedExperiment(list(counts = counts), colData = sampleMetadata) +# +# # Currently getting this error: Error in is.infinite(o1) : default method not implemented for type 'list' +# # Ignoring for now. +# output_abs = ANCOMBC::ancombc2(data = se, assay_name = "counts", tax_level = NULL, +# fix_formula = comparatorColName, rand_formula = NULL, +# p_adj_method = "holm", prv_cut=0, +# group = comparatorColName) +# + } else if (identical(method, 'Maaslin')) { + statistics <- maaslin(data, comparator, verbose) + } else { + stop('Unaccepted differential abundance method. Accepted methods are "DESeq" and "Maaslin".') + } + veupathUtils::logWithTime(paste0('Completed method=',method,'. Formatting results.'), verbose) + + # Sometimes p-values can be very small, even smaller than the smallest representable number (gives p-value=0). The smallest + # representable number changes based on env, so to avoid inconsistency set a p-value floor so that any + # returned p-value less than the floor becomes the floor. + # The default floor is a constant defined in the microbiomeComputations package. + + # First find indices of the small p-values and update these values to be the pValueFloor + smallPValueIndices <- which(statistics@statistics[["pValue"]] < pValueFloor) + if (length(smallPValueIndices) > 0) { + statistics@statistics[smallPValueIndices, "pValue"] <- pValueFloor + + # Second, find the adjusted p value floor by taking the largest adjusted p-value of those p-values that were floored + smallAdjPValues <- statistics@statistics[smallPValueIndices, "adjustedPValue"] + adjustedPValueFloor <- max(smallAdjPValues) + + # Finally, update the adjusted p-values with the floor + statistics@statistics[smallPValueIndices, "adjustedPValue"] <- adjustedPValueFloor + } else { + adjustedPValueFloor <- NA_real_ + } + statistics@pValueFloor <- pValueFloor + statistics@adjustedPValueFloor <- adjustedPValueFloor + + + # this is droppedTaxa, or pathways etc ?? can we rename it? + droppedColumns <- setdiff(names(data@data[, -..allIdColumns, with=FALSE]), statistics@statistics$pointID) + + ## Construct the ComputeResult + result <- new("ComputeResult") + result@name <- 'differentialAbundance' + result@recordIdColumn <- recordIdColumn + result@ancestorIdColumns <- ancestorIdColumns + result@statistics <- statistics + result@parameters <- paste0('recordIdColumn = ', recordIdColumn,", comparatorColName = ", comparatorColName, ', method = ', method, ', groupA =', getGroupLabels(comparator, "groupA"), ', groupB = ', getGroupLabels(comparator, "groupB")) + result@droppedColumns <- droppedColumns + + + # The resulting data should contain only the samples actually used. + result@data <- data@data[, ..allIdColumns] + names(result@data) <- veupathUtils::stripEntityIdFromColumnHeader(names(result@data)) + + + validObject(result) + veupathUtils::logWithTime(paste('Differential abundance computation completed with parameters recordIdColumn = ', recordIdColumn,", comparatorColName = ", comparatorColName, ', method = ', method, ', groupA =', getGroupLabels(comparator, "groupA"), ', groupB = ', getGroupLabels(comparator, "groupB")), verbose) + + return(result) +}) diff --git a/tests/testthat/test-method-differentialExpression.R b/tests/testthat/test-method-differentialExpression.R new file mode 100644 index 0000000..583dbba --- /dev/null +++ b/tests/testthat/test-method-differentialExpression.R @@ -0,0 +1,697 @@ +# Tests for differential abundance methods + +test_that('differentialAbundance returns a correctly formatted data.table', { + + # df <- testCountsData + # Create a data frame of counts + nSamples <- 1200 + nGenes <- 100 + set.seed(123) + df <- data.frame(matrix(rpois(nSamples*nGenes, 10), nrow=nSamples)) + colnames(df) <- c(paste0("gene", 1:nGenes)) + df$entity.SampleID <- paste0("sample", 1:nSamples) + + testSampleMetadata <- data.frame(list( + "entity.SampleID" = df[["entity.SampleID"]], + "entity.binA" = rep(c("binA_a", "binA_b"), nSamples/2, replace=T), + "entity.cat3" = rep(paste0("cat3_", letters[1:3]), nSamples/3, replace=T), + "entity.cat4" = rep(paste0("cat4_", letters[1:4]), nSamples/4, replace=T), + "entity.contA" = rnorm(nSamples, sd=5), + "entity.dateA" = sample(seq(as.Date('1988/01/01'), as.Date('2000/01/01'), by="day"), nSamples) + )) + + + testData <- veupathUtils::CountDataCollection( + data = counts, + sampleMetadata = SampleMetadata( + data = testSampleMetadata, + recordIdColumn = "entity.SampleID" + ), + recordIdColumn = 'entity.SampleID') + + + + # A Binary comparator variable + comparatorVariable <- veupathUtils::Comparator( + variable = veupathUtils::VariableMetadata( + variableSpec = VariableSpec( + variableId = 'binA', + entityId = 'entity' + ), + dataShape = veupathUtils::DataShape(value="BINARY") + ), + groupA = veupathUtils::BinList( + S4Vectors::SimpleList( + c(veupathUtils::Bin( + binLabel="binA_a" + )) + ) + ), + groupB = veupathUtils::BinList( + S4Vectors::SimpleList( + c(veupathUtils::Bin( + binLabel="binA_b" + )) + ) + ) + ) + + result <- differentialAbundance(testData, comparator=comparatorVariable, method='DESeq', verbose=F) + expect_equal(length(result@droppedColumns), 182) + dt <- result@data + expect_equal(names(dt), c('SampleID')) + expect_s3_class(dt, 'data.table') + stats <- result@statistics@statistics + expect_s3_class(stats, 'data.frame') + expect_equal(result@statistics@effectSizeLabel, 'log2(Fold Change)') + expect_equal(names(stats), c('effectSize','pValue','adjustedPValue','pointID')) + expect_equal(unname(unlist(lapply(stats, class))), c('numeric','numeric','numeric','character')) + expect_true(all(!is.na(stats[, c('effectSize', 'pValue', 'pointID')]))) + + + # When defined groups end up subsetting the incoming data + comparatorVariable <- veupathUtils::Comparator( + variable = veupathUtils::VariableMetadata( + variableSpec = VariableSpec( + variableId = 'cat4', + entityId = 'entity' + ), + dataShape = veupathUtils::DataShape(value="CATEGORICAL") + ), + groupA = veupathUtils::BinList( + S4Vectors::SimpleList( + c(veupathUtils::Bin( + binLabel="cat4_a" + )) + ) + ), + groupB = veupathUtils::BinList( + S4Vectors::SimpleList( + c(veupathUtils::Bin( + binLabel="cat4_b" + )) + ) + ) + ) + result <- differentialAbundance(testData, comparator=comparatorVariable, method='DESeq', verbose=F) + expect_equal(length(result@droppedColumns), 407) + dt <- result@data + expect_equal(names(dt), c('SampleID')) + expect_s3_class(dt, 'data.table') + expect_equal(sum(testSampleMetadata$entity.cat4 %in% c('cat4_a','cat4_b')), nrow(dt)) + stats <- result@statistics@statistics + expect_s3_class(stats, 'data.frame') + expect_equal(result@statistics@effectSizeLabel, 'log2(Fold Change)') + expect_equal(names(stats), c('effectSize','pValue','adjustedPValue','pointID')) + expect_equal(unname(unlist(lapply(stats, class))), c('numeric','numeric','numeric','character')) + expect_true(all(!is.na(stats[, c('effectSize', 'pValue', 'pointID')]))) + + + # With a continuous variable + bin1 <- veupathUtils::Bin(binStart='2', binEnd='3', binLabel="[2, 3)") + bin2 <- veupathUtils::Bin(binStart='3', binEnd='4', binLabel="[3, 4)") + bin3 <- veupathUtils::Bin(binStart='4', binEnd='5', binLabel="[4, 5)") + bin4 <- veupathUtils::Bin(binStart='5', binEnd='6', binLabel="[5, 6)") + + groupABins <- veupathUtils::BinList(S4Vectors::SimpleList(c(bin1, bin2))) + groupBBins <- veupathUtils::BinList(S4Vectors::SimpleList(c(bin3, bin4))) + + comparatorVariable <- veupathUtils::Comparator( + variable = veupathUtils::VariableMetadata( + variableSpec = VariableSpec( + variableId = 'contA', + entityId = 'entity' + ), + dataShape = veupathUtils::DataShape(value="CONTINUOUS") + ), + groupA = groupABins, + groupB = groupBBins + ) + + result <- differentialAbundance(testData, comparator=comparatorVariable, method='DESeq', verbose=F) + dt <- result@data + expect_equal(names(dt), c('SampleID')) + expect_s3_class(dt, 'data.table') + expect_equal(nrow(dt), sum((testSampleMetadata[['entity.contA']] >= 2) * (testSampleMetadata[['entity.contA']] < 6))) + stats <- result@statistics@statistics + expect_s3_class(stats, 'data.frame') + expect_equal(result@statistics@effectSizeLabel, 'log2(Fold Change)') + expect_equal(names(stats), c('effectSize','pValue','adjustedPValue','pointID')) + expect_equal(unname(unlist(lapply(stats, class))), c('numeric','numeric','numeric','character')) + + ## With dates + bin1 <- Bin(binStart=as.Date('1989-01-01'), binEnd=as.Date('1990-01-01'), binLabel='1989') + bin2 <- Bin(binStart=as.Date('1990-01-01'), binEnd=as.Date('1991-01-01'), binLabel='1990') + bin3 <- Bin(binStart=as.Date('1991-01-01'), binEnd=as.Date('1992-01-01'), binLabel='1991') + bin4 <- Bin(binStart=as.Date('1992-01-01'), binEnd=as.Date('1993-01-01'), binLabel='1992') + groupABins <- BinList(S4Vectors::SimpleList(c(bin1, bin2))) + groupBBins <- BinList(S4Vectors::SimpleList(c(bin3, bin4))) + + comparatorVariable <- veupathUtils::Comparator( + variable = veupathUtils::VariableMetadata( + variableSpec = VariableSpec( + variableId = 'dateA', + entityId = 'entity' + ), + dataShape = veupathUtils::DataShape(value="CONTINUOUS") + ), + groupA = groupABins, + groupB = groupBBins + ) + + result <- differentialAbundance(testData, comparator=comparatorVariable, method='DESeq', verbose=F) + dt <- result@data + expect_equal(names(dt), c('SampleID')) + expect_s3_class(dt, 'data.table') + expect_equal(nrow(dt), sum((testSampleMetadata[['entity.dateA']] >= as.Date('1989-01-01')) * (testSampleMetadata[['entity.dateA']] < as.Date('1993-01-01')))) + stats <- result@statistics@statistics + expect_s3_class(stats, 'data.frame') + expect_equal(result@statistics@effectSizeLabel, 'log2(Fold Change)') + expect_equal(names(stats), c('effectSize','pValue','adjustedPValue','pointID')) + expect_equal(unname(unlist(lapply(stats, class))), c('numeric','numeric','numeric','character')) + +}) + +test_that("differentialAbundance can handle messy inputs", { + + df <- testOTU + counts <- round(df[, -c("entity.SampleID")]*1000) # make into "counts" + counts[ ,entity.SampleID:= df$entity.SampleID] + nSamples <- dim(df)[1] + testSampleMetadataMessy <- data.frame(list( + "entity.SampleID" = df[["entity.SampleID"]], + "entity.binA" = rep(c("binA_a", "binA_b"), nSamples/2, replace=T), + "entity.cat3" = rep(paste0("cat3_", letters[1:3]), nSamples/3, replace=T), + "entity.cat4" = rep(paste0("cat4_", letters[1:4]), nSamples/4, replace=T), + "entity.contA" = rnorm(nSamples, sd=5), + "entity.dateA" = sample(seq(as.Date('1988/01/01'), as.Date('2000/01/01'), by="day"), nSamples) + )) + testSampleMetadataMessy$entity.contA[sample(1:nSamples, 50)] <- NA + testSampleMetadataMessy$entity.cat4[sample(1:nSamples, 50)] <- NA + + + testDataMessy <- veupathUtils::CountDataCollection( + data = counts, + sampleMetadata = SampleMetadata( + data = testSampleMetadataMessy, + recordIdColumn = "entity.SampleID" + ), + recordIdColumn = 'entity.SampleID') + + + # With only some comparisonVariable values found in the metadata + comparatorVariable <- veupathUtils::Comparator( + variable = veupathUtils::VariableMetadata( + variableSpec = VariableSpec( + variableId = 'cat4', + entityId = 'entity' + ), + dataShape = veupathUtils::DataShape(value="CATEGORICAL") + ), + groupA = veupathUtils::BinList( + S4Vectors::SimpleList( + c(veupathUtils::Bin( + binLabel="cat4_a" + ), veupathUtils::Bin( + binLabel="cat4_c" + )) + ) + ), + groupB = veupathUtils::BinList( + S4Vectors::SimpleList( + c(veupathUtils::Bin( + binLabel="cat4_b" + ), veupathUtils::Bin( + binLabel="test" + )) + ) + ) + ) + + result <- differentialAbundance(testDataMessy, comparator=comparatorVariable, method='DESeq', verbose=F) + dt <- result@data + expect_equal(names(dt), c('SampleID')) + expect_s3_class(dt, 'data.table') + expect_equal(sum(testSampleMetadataMessy$entity.cat4 %in% c('cat4_a','cat4_b','cat4_c')), nrow(dt)) + stats <- result@statistics@statistics + expect_s3_class(stats, 'data.frame') + expect_equal(result@statistics@effectSizeLabel, 'log2(Fold Change)') + expect_equal(names(stats), c('effectSize','pValue','adjustedPValue','pointID')) + expect_equal(unname(unlist(lapply(stats, class))), c('numeric','numeric','numeric','character')) + expect_true(all(!is.na(stats[, c('effectSize', 'pValue', 'pointID')]))) + + + # With a continuous variable that has NAs + bin1 <- veupathUtils::Bin(binStart='2', binEnd='3', binLabel="[2, 3)") + bin2 <- veupathUtils::Bin(binStart='3', binEnd='4', binLabel="[3, 4)") + bin3 <- veupathUtils::Bin(binStart='4', binEnd='5', binLabel="[4, 5)") + bin4 <- veupathUtils::Bin(binStart='5', binEnd='6', binLabel="[5, 6)") + + groupABins <- veupathUtils::BinList(S4Vectors::SimpleList(c(bin1, bin2))) + groupBBins <- veupathUtils::BinList(S4Vectors::SimpleList(c(bin3, bin4))) + + comparatorVariable <- veupathUtils::Comparator( + variable = veupathUtils::VariableMetadata( + variableSpec = VariableSpec( + variableId = 'contA', + entityId = 'entity' + ), + dataShape = veupathUtils::DataShape(value="CONTINUOUS") + ), + groupA = groupABins, + groupB = groupBBins + ) + + result <- differentialAbundance(testDataMessy, comparator=comparatorVariable, method='DESeq', verbose=F) + dt <- result@data + expect_equal(names(dt), c('SampleID')) + expect_s3_class(dt, 'data.table') + expect_equal(nrow(dt), sum((testSampleMetadataMessy[['entity.contA']] >= 2) * (testSampleMetadataMessy[['entity.contA']] < 6), na.rm=T)) + stats <- result@statistics@statistics + expect_s3_class(stats, 'data.frame') + expect_equal(result@statistics@effectSizeLabel, 'log2(Fold Change)') + expect_equal(names(stats), c('effectSize','pValue','adjustedPValue','pointID')) + expect_equal(unname(unlist(lapply(stats, class))), c('numeric','numeric','numeric','character')) + + + # With a categorical variable that has NAs + bin1 <- veupathUtils::Bin(binLabel="cat4_a") + bin2 <- veupathUtils::Bin(binLabel="cat4_b") + bin3 <- veupathUtils::Bin(binLabel="cat4_c") + + groupABins <- veupathUtils::BinList(S4Vectors::SimpleList(c(bin1, bin2))) + groupBBins <- veupathUtils::BinList(S4Vectors::SimpleList(c(bin3))) + + comparatorVariable <- veupathUtils::Comparator( + variable = veupathUtils::VariableMetadata( + variableSpec = VariableSpec( + variableId = 'cat4', + entityId = 'entity' + ), + dataShape = veupathUtils::DataShape(value="CATEGORICAL") + ), + groupA = groupABins, + groupB = groupBBins + ) + result <- differentialAbundance(testDataMessy, comparator=comparatorVariable, method='DESeq', verbose=T) + dt <- result@data + expect_equal(names(dt), c('SampleID')) + expect_s3_class(dt, 'data.table') + expect_equal(nrow(dt), sum(testSampleMetadataMessy$entity.cat4 %in% c('cat4_a','cat4_b','cat4_c'))) + stats <- result@statistics@statistics + expect_s3_class(stats, 'data.frame') + expect_equal(result@statistics@effectSizeLabel, 'log2(Fold Change)') + expect_equal(names(stats), c('effectSize','pValue','adjustedPValue','pointID')) + expect_equal(unname(unlist(lapply(stats, class))), c('numeric','numeric','numeric','character')) + + +}) + + +test_that("differentialAbundance returns a ComputeResult with the correct slots" , { + + df <- testOTU + counts <- round(df[, -c("entity.SampleID")]*1000) # make into "counts" + counts[ ,entity.SampleID:= df$entity.SampleID] + nSamples <- dim(df)[1] + sampleMetadata <- SampleMetadata( + data = data.frame(list( + "entity.SampleID" = df[["entity.SampleID"]], + "entity.binA" = sample(c("binA_a", "binA_b"), nSamples, replace=T), + "entity.cat2" = sample(c("cat2_a", "cat2_b"), nSamples, replace=T), + "entity.cat3" = sample(paste0("cat3_", letters[1:3]), nSamples, replace=T), + "entity.cat4" = sample(paste0("cat4_", letters[1:4]), nSamples, replace=T) + )), + recordIdColumn = "entity.SampleID" + ) + + + testData <- veupathUtils::CountDataCollection( + data = counts, + sampleMetadata = sampleMetadata, + recordIdColumn = 'entity.SampleID') + + comparatorVariable <- veupathUtils::Comparator( + variable = veupathUtils::VariableMetadata( + variableSpec = VariableSpec( + variableId = 'binA', + entityId = 'entity' + ), + dataShape = veupathUtils::DataShape(value="BINARY") + ), + groupA = veupathUtils::BinList( + S4Vectors::SimpleList( + c(veupathUtils::Bin( + binLabel="binA_a" + )) + ) + ), + groupB = veupathUtils::BinList( + S4Vectors::SimpleList( + c(veupathUtils::Bin( + binLabel="binA_b" + )) + ) + ) + ) + + result <- differentialAbundance(testData, comparator=comparatorVariable, method='DESeq', verbose=F) + expect_equal(result@parameters, 'recordIdColumn = entity.SampleID, comparatorColName = entity.binA, method = DESeq, groupA =binA_a, groupB = binA_b') + expect_equal(result@recordIdColumn, 'entity.SampleID') + expect_equal(class(result@droppedColumns), 'character') +}) + +test_that("differentialAbundance fails with improper inputs", { + + df <- testOTU + counts <- round(df[, -c("entity.SampleID")]*1000) # make into "counts" + counts[ ,entity.SampleID:= df$entity.SampleID] + nSamples <- dim(df)[1] + sampleMetadata <- SampleMetadata( + data = data.frame(list( + "entity.SampleID" = df[["entity.SampleID"]], + "entity.binA" = sample(c("binA_a", "binA_b"), nSamples, replace=T), + "entity.cat2" = sample(c("cat2_a", "cat2_b"), nSamples, replace=T), + "entity.cat3" = sample(paste0("cat3_", letters[1:3]), nSamples, replace=T), + "entity.cat4" = sample(paste0("cat4_", letters[1:4]), nSamples, replace=T), + "entity.contA" = rnorm(nSamples, sd=5) + )), + recordIdColumn = "entity.SampleID" + ) + + + testData <- veupathUtils::CountDataCollection( + data = counts, + sampleMetadata = sampleMetadata, + recordIdColumn = 'entity.SampleID') + + + + # Fail when bins in Group A and Group B overlap + bin1 <- veupathUtils::Bin(binStart=2, binEnd=3, binLabel="[2, 3)") + bin2 <- veupathUtils::Bin(binStart=3, binEnd=4, binLabel="[3, 4)") + bin3 <- veupathUtils::Bin(binStart=3, binEnd=5, binLabel="[3, 5)") + bin4 <- veupathUtils::Bin(binStart=5, binEnd=6, binLabel="[5, 6)") + groupABins <- BinList(S4Vectors::SimpleList(c(bin1, bin2))) + groupBBins <- BinList(S4Vectors::SimpleList(c(bin3, bin4))) + comparatorVariable <- veupathUtils::Comparator( + variable = veupathUtils::VariableMetadata( + variableSpec = VariableSpec( + variableId = 'contA', + entityId = 'entity' + ), + dataShape = veupathUtils::DataShape(value="CONTINUOUS") + ), + groupA = groupABins, + groupB = groupBBins + ) + + expect_error(differentialAbundance(testData, comparator=comparisonVariable, method='DESeq', verbose=F)) + +}) + +test_that("differentialAbundance catches deseq errors", { + + df <- testOTU + counts <- round(df[, -c("entity.SampleID")]*1000) # make into "counts" + counts[ ,entity.SampleID:= df$entity.SampleID] + nSamples <- dim(df)[1] + sampleMetadata <- SampleMetadata( + data = data.frame(list( + "entity.SampleID" = df[["entity.SampleID"]], + "entity.binA" = rep(c("binA_a", "binA_b"), nSamples/2, replace=T) + )), + recordIdColumn ="entity.SampleID" + ) + + comparatorVariable <- veupathUtils::Comparator( + variable = veupathUtils::VariableMetadata( + variableSpec = VariableSpec( + variableId = 'binA', + entityId = 'entity' + ), + dataShape = veupathUtils::DataShape(value="BINARY") + ), + groupA = veupathUtils::BinList( + S4Vectors::SimpleList( + c(veupathUtils::Bin( + binLabel="binA_a" + )) + ) + ), + groupB = veupathUtils::BinList( + S4Vectors::SimpleList( + c(veupathUtils::Bin( + binLabel="binA_b" + )) + ) + ) + ) + + # Use only a few taxa + testData <- veupathUtils::CountDataCollection( + data = counts[, c("entity.SampleID","entity.1174-901-12","entity.A2")], + sampleMetadata = sampleMetadata, + recordIdColumn = 'entity.SampleID') + + expect_error(differentialAbundance(testData, comparator=comparisonVariable, method='DESeq', verbose=T)) + + +}) + +# test_that("differentialAbundance method Maaslin does stuff",{ +# df <- testOTU +# counts <- round(df[, -c("entity.SampleID")]*1000) +# counts[ ,entity.SampleID:= df$entity.SampleID] +# nSamples <- dim(df)[1] +# testSampleMetadata <- SampleMetadata( +# data = data.frame(list( +# "entity.SampleID" = df[["entity.SampleID"]], +# "entity.binA" = rep(c("binA_a", "binA_b"), nSamples/2, replace=T), +# "entity.cat3" = rep(paste0("cat3_", letters[1:3]), nSamples/3, replace=T), +# "entity.cat4" = rep(paste0("cat4_", letters[1:4]), nSamples/4, replace=T), +# "entity.contA" = rnorm(nSamples, sd=5) +# )), +# recordIdColumn ="entity.SampleID" +# ) + + +# testCountsData <- veupathUtils::AbsoluteAbundanceData( +# data = counts, +# sampleMetadata = testSampleMetadata, +# recordIdColumn = 'entity.SampleID') + +# testData <- veupathUtils::AbundanceData( +# data = df, +# sampleMetadata = testSampleMetadata, +# recordIdColumn = 'entity.SampleID' +# ) + +# comparatorVariable <- veupathUtils::Comparator( +# variable = veupathUtils::VariableMetadata( +# variableSpec = VariableSpec( +# variableId = 'cat4', +# entityId = 'entity' +# ), +# dataShape = veupathUtils::DataShape(value="CATEGORICAL") +# ), +# groupA = veupathUtils::BinList( +# S4Vectors::SimpleList( +# c(veupathUtils::Bin( +# binLabel="cat4_a" +# )) +# ) +# ), +# groupB = veupathUtils::BinList( +# S4Vectors::SimpleList( +# c(veupathUtils::Bin( +# binLabel="cat4_b" +# )) +# ) +# ) +# ) + +# result <- differentialAbundance(testData, +# comparator = comparatorVariable, +# method='Maaslin', +# verbose=F) +# dt <- result@data +# stats <- result@statistics@statistics + + +# resultCounts <- differentialAbundance(testCountsData, +# comparator = comparatorVariable, +# method='Maaslin', +# verbose=F) +# dtCounts <- result@data +# statsCounts <- result@statistics@statistics + +# expect_equal(dt, dtCounts) +# expect_equal(result@statistics@effectSizeLabel, 'Model Coefficient (Effect Size)') +# expect_true(length(stats$pointID) > 0) +# expect_true(length(statsCounts$pointID) > 0) +# expect_equal(stats, statsCounts) +# }) + +test_that("toJSON for DifferentialAbundanceResult works",{ + df <- testOTU + nSamples <- dim(df)[1] + df$entity.wowtaxa <- rep(c(0.01, 0.99), nSamples/2, replace=T) # will 'wow' us with its significance + nSamples <- dim(df)[1] + testSampleMetadata <- data.frame(list( + "entity.SampleID" = df[["entity.SampleID"]], + "entity.binA" = rep(c("binA_a", "binA_b"), nSamples/2, replace=T) + )) + + testData <- veupathUtils::CountDataCollection( + data = df, + sampleMetadata = SampleMetadata( + data = testSampleMetadata, + recordIdColumn = "entity.SampleID" + ), + recordIdColumn = 'entity.SampleID' + ) + + comparatorVariable <- veupathUtils::Comparator( + variable = veupathUtils::VariableMetadata( + variableSpec = VariableSpec( + variableId = 'binA', + entityId = 'entity' + ), + dataShape = veupathUtils::DataShape(value="CATEGORICAL") + ), + groupA = veupathUtils::BinList( + S4Vectors::SimpleList( + c(veupathUtils::Bin( + binLabel="binA_a" + )) + ) + ), + groupB = veupathUtils::BinList( + S4Vectors::SimpleList( + c(veupathUtils::Bin( + binLabel="binA_b" + )) + ) + ) + ) + + result <- differentialAbundance(testData, + comparator = comparatorVariable, + method='Maaslin', + verbose=F) + stats <- result@statistics + jsonList <- jsonlite::fromJSON(toJSON(result@statistics)) + + expect_true(all(c('effectSizeLabel', 'statistics', 'pValueFloor', 'adjustedPValueFloor') %in% names(jsonList))) + expect_true(all(c('effectSize', 'pValue', 'adjustedPValue', 'pointID') %in% names(jsonList$statistics))) + expect_true(is.character(jsonList$statistics$effectSize)) + expect_true(is.character(jsonList$statistics$pValue)) + expect_true(is.character(jsonList$statistics$adjustedPValue)) + expect_true(is.character(jsonList$pValueFloor)) + expect_true(is.character(jsonList$adjustedPValueFloor)) +}) + +test_that("The smallest pvalue we can get is our p value floor", { + + df <- testOTU + counts <- round(df[, -c("entity.SampleID")]*1000) # make into "counts" + counts[ ,entity.SampleID:= df$entity.SampleID] + nSamples <- dim(df)[1] + counts$entity.wowtaxa <- rep(c(1, 100), nSamples/2, replace=T) # will 'wow' us with its significance + nSamples <- dim(df)[1] + testSampleMetadata <- data.frame(list( + "entity.SampleID" = df[["entity.SampleID"]], + "entity.binA" = rep(c("binA_a", "binA_b"), nSamples/2, replace=T) + )) + + testData <- veupathUtils::CountDataCollection( + data = counts, + sampleMetadata = SampleMetadata( + data = testSampleMetadata, + recordIdColumn = "entity.SampleID" + ), + recordIdColumn = 'entity.SampleID' + ) + + # A Binary comparator variable + comparatorVariable <- veupathUtils::Comparator( + variable = veupathUtils::VariableMetadata( + variableSpec = VariableSpec( + variableId = 'binA', + entityId = 'entity' + ), + dataShape = veupathUtils::DataShape(value="BINARY") + ), + groupA = veupathUtils::BinList( + S4Vectors::SimpleList( + c(veupathUtils::Bin( + binLabel="binA_a" + )) + ) + ), + groupB = veupathUtils::BinList( + S4Vectors::SimpleList( + c(veupathUtils::Bin( + binLabel="binA_b" + )) + ) + ) + ) + + # Try with different p value floors + result <- differentialAbundance(testData, comparator=comparatorVariable, method='DESeq', pValueFloor = 0, verbose=F) + expect_equal(min(result@statistics@statistics$pValue), 0) + expect_equal(min(result@statistics@statistics$adjustedPValue, na.rm=T), 0) # Confirmed NAs are for pvalue=1 + + result <- differentialAbundance(testData, comparator=comparatorVariable, method='DESeq', pValueFloor = P_VALUE_FLOOR, verbose=F) + expect_equal(min(result@statistics@statistics$pValue), P_VALUE_FLOOR) + expect_equal(min(result@statistics@statistics$adjustedPValue, na.rm=T), result@statistics@adjustedPValueFloor) # Confirmed NAs are for pvalue=1 + + + + # Repeat with Maaslin + result <- differentialAbundance(testData, comparator=comparatorVariable, method='Maaslin', pValueFloor = 0, verbose=F) + expect_equal(min(result@statistics@statistics$pValue), 0) + expect_equal(min(result@statistics@statistics$adjustedPValue), 0) + + result <- differentialAbundance(testData, comparator=comparatorVariable, method='Maaslin', pValueFloor = P_VALUE_FLOOR, verbose=F) + expect_equal(min(result@statistics@statistics$pValue), P_VALUE_FLOOR) + expect_equal(min(result@statistics@statistics$adjustedPValue), result@statistics@adjustedPValueFloor) + + +}) + +test_that("differentialAbundance fails if comparator has one value", { + + df <- testOTU + + sampleMetadata <- SampleMetadata( + data = data.frame(list( + "entity.SampleID" = df[["entity.SampleID"]], + "entity.binA" = rep(c("binA"), nrow(df)) + )), + recordIdColumn ="entity.SampleID" + ) + + testData <- veupathUtils::CountDataCollection( + data = df, + sampleMetadata = sampleMetadata, + recordIdColumn = 'entity.SampleID' + ) + + comparatorVariable <- veupathUtils::Comparator( + variable = veupathUtils::VariableMetadata( + variableSpec = VariableSpec( + variableId = 'binA', + entityId = 'entity' + ), + dataShape = veupathUtils::DataShape(value="BINARY") + ), + groupA = veupathUtils::BinList(S4Vectors::SimpleList(c(veupathUtils::Bin(binLabel="binA")))), + groupB = veupathUtils::BinList(S4Vectors::SimpleList(c(veupathUtils::Bin(binLabel="binB")))) + ) + + expect_error(differentialAbundance(testData, comparator=comparatorVariable, method='DESeq', verbose=F)) + expect_error(differentialAbundance(testData, comparator=comparatorVariable, method='Maaslin', verbose=F)) +}) \ No newline at end of file From 2b54b8bc33c75dd31e7aa20e2b29b860e5d32f39 Mon Sep 17 00:00:00 2001 From: asizemore Date: Fri, 25 Oct 2024 17:35:01 -0400 Subject: [PATCH 2/4] add CountDataCollection class --- DESCRIPTION | 3 ++ NAMESPACE | 13 +++++++ R/class-Comparator.R | 1 + ...llection.R => class-CountDataCollection.R} | 17 +++++++-- R/method-differentialExpression.R | 2 +- data/P_VALUE_FLOOR.rda | Bin 0 -> 102 bytes data/testCountData.RData | Bin 0 -> 49222 bytes man/Comparator-class.Rd | 21 +++++++++++ man/CountDataCollection-class.Rd | 24 +++++++++++++ man/differentialAbundance.Rd | 33 ++++++++++++++++++ .../testthat/test-class-CountDataCollection.R | 30 ++++++++++++++++ 11 files changed, 141 insertions(+), 3 deletions(-) rename R/{class-CountsDataCollection.R => class-CountDataCollection.R} (70%) create mode 100644 data/P_VALUE_FLOOR.rda create mode 100644 data/testCountData.RData create mode 100644 man/Comparator-class.Rd create mode 100644 man/CountDataCollection-class.Rd create mode 100644 man/differentialAbundance.Rd create mode 100644 tests/testthat/test-class-CountDataCollection.R diff --git a/DESCRIPTION b/DESCRIPTION index e322116..45d1639 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -44,13 +44,16 @@ Collate: 'class-SampleMetadata.R' 'class-CollectionWithMetadata.R' 'class-VariableMetadata.R' + 'class-Comparator.R' 'class-ComputeResult.R' 'class-CorrelationResult.R' + 'class-CountDataCollection.R' 'class-Megastudy.R' 'class-Range.R' 'class-Statistic.R' 'data.R' 'method-correlation.R' + 'method-differentialExpression.R' 'methods-Bin.R' 'methods-CollectionWithMetadata.R' 'methods-Collections.R' diff --git a/NAMESPACE b/NAMESPACE index b8c035b..3aac58e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -13,10 +13,13 @@ export(BinList) export(Collection) export(CollectionWithMetadata) export(Collections) +export(Comparator) export(ComputeResult) export(CorrelationResult) +export(CountDataCollection) export(DataShape) export(DataType) +export(DifferentialAbundanceResult) export(Megastudy) export(PlotReference) export(Range) @@ -40,6 +43,7 @@ export(cut_interval) export(cut_number) export(cut_width) export(data_frame) +export(differentialAbundance) export(findAllColNames) export(findAncestorIdColumns) export(findColNamesByPredicate) @@ -118,10 +122,13 @@ exportClasses(Bin) exportClasses(BinList) exportClasses(Collection) exportClasses(CollectionWithMetadata) +exportClasses(Comparator) exportClasses(ComputeResult) exportClasses(CorrelationResult) +exportClasses(CountDataCollection) exportClasses(DataShape) exportClasses(DataType) +exportClasses(DifferentialAbundanceResult) exportClasses(Megastudy) exportClasses(PlotReference) exportClasses(Range) @@ -136,6 +143,7 @@ exportClasses(VariableMetadataList) exportClasses(VariableSpec) exportClasses(VariableSpecList) exportMethods(as.numeric) +exportMethods(differentialAbundance) exportMethods(findAllColNames) exportMethods(findColNamesByPredicate) exportMethods(findColNamesFromPlotRef) @@ -167,14 +175,19 @@ exportMethods(whichValuesInBinList) exportMethods(writeData) exportMethods(writeMeta) exportMethods(writeStatistics) +import(DESeq2) import(data.table) importFrom(Hmisc,rcorr) +importFrom(Maaslin2,Maaslin2) importFrom(S4Vectors,SimpleList) importFrom(SpiecEasi,pval.sparccboot) importFrom(SpiecEasi,sparcc) importFrom(SpiecEasi,sparccboot) importFrom(digest,digest) importFrom(microbenchmark,microbenchmark) +importFrom(purrr,discard) importFrom(purrr,map) importFrom(purrr,map_lgl) +importFrom(purrr,none) importFrom(stringi,stri_detect_regex) +useDynLib(microbiomeComputations) diff --git a/R/class-Comparator.R b/R/class-Comparator.R index baaffe9..502169b 100644 --- a/R/class-Comparator.R +++ b/R/class-Comparator.R @@ -66,6 +66,7 @@ check_comparator <- function(object) { #' @slot groupB BinList #' @name Comparator-class #' @rdname Comparator-class +#' @include class-VariableMetadata.R #' @export Comparator <- setClass("Comparator", representation( variable = 'VariableMetadata', diff --git a/R/class-CountsDataCollection.R b/R/class-CountDataCollection.R similarity index 70% rename from R/class-CountsDataCollection.R rename to R/class-CountDataCollection.R index 9dd8be8..c7c8997 100644 --- a/R/class-CountsDataCollection.R +++ b/R/class-CountDataCollection.R @@ -5,11 +5,24 @@ check_count_data_collection <- function(object) { ancestor_id_cols <- object@ancestorIdColumns all_id_cols <- c(record_id_col, ancestor_id_cols) + + allDataColsNumeric <- all(unlist(lapply(df[, !(names(df) %in% c(record_id_col, ancestor_id_cols))], is.numeric))) + if (inherits(df, 'data.table')) allDataColsNumeric <- all(unlist(lapply(df[, !(names(df) %in% c(record_id_col, ancestor_id_cols)), with=F], is.numeric))) + if (!allDataColsNumeric) { + msg <- paste("All columns except the ID columns must be numeric.") + errors <- c(errors, msg) + } + numeric_data <- df[, !(names(df) %in% all_id_cols)] if (inherits(df, 'data.table')) numeric_data <- df[, !(names(df) %in% all_id_cols), with=F] if (!identical(numeric_data, round(numeric_data))) { - msg <- "Absolute abundance data must be integer numbers." + msg <- "Count data must be integer numbers." + errors <- c(errors, msg) + } + + if (any(df < 0, na.rm=TRUE)) { + msg <- paste("Count data cannot contain negative values.") errors <- c(errors, msg) } @@ -17,7 +30,7 @@ check_count_data_collection <- function(object) { return(if (length(errors) == 0) TRUE else errors) } -#' Counts Data +#' Count Data #' #' A class for working with count data, including microbial or genetic assays. #' diff --git a/R/method-differentialExpression.R b/R/method-differentialExpression.R index 300ccf0..4fb0555 100644 --- a/R/method-differentialExpression.R +++ b/R/method-differentialExpression.R @@ -229,7 +229,7 @@ setMethod("maaslin", signature("AbundanceData", "Comparator"), function(data, co #' @importFrom Maaslin2 Maaslin2 #' @importFrom purrr none #' @importFrom purrr discard -# ' @useDynLib microbiomeComputations ANN WHAT DOES THIS MEAN +#' @useDynLib microbiomeComputations #' @export setGeneric("differentialAbundance", function(data, comparator, method = c('DESeq', 'Maaslin'), pValueFloor = P_VALUE_FLOOR, verbose = c(TRUE, FALSE)) standardGeneric("differentialAbundance"), diff --git a/data/P_VALUE_FLOOR.rda b/data/P_VALUE_FLOOR.rda new file mode 100644 index 0000000000000000000000000000000000000000..579f6ef68e337c2f6dfe5add078f9fa70048bcf7 GIT binary patch literal 102 zcmV-s0GaJCk4|$fIt8N5C8xK0D&L?R8cW7 z0002g+M`cI&;~=)Xc#Njbx`22CMCfMC{PZvBDY%6Zup-3wG-t<8 literal 0 HcmV?d00001 diff --git a/data/testCountData.RData b/data/testCountData.RData new file mode 100644 index 0000000000000000000000000000000000000000..0754dade445710b72fc6aa0dc2c51c89800366ed GIT binary patch literal 49222 zcmYIwdpy(q`~OO%lbn;xp(7>M+1Usw$~nqucgl?pnDelWR1T|2DV^q+D6w0S^H!mW zm}3($%vr3NnQgXxU+eRGJbwM*G4^`DU+3$3KA+chrHR`J`TI}m_t2&oH5v*QUwJ+b zEhwxxH})!c?qhY?TrKYgBCU6p)2Dw)&E^_?YpDFD)Gg~CKGbPj4$P|WUffSij7Hf{ z4@&Judh|9mG34v&M&F`w-UI4t!Yax8qqQ!%qV$0K0!yAjOd zpU}fkjd~2@B853b5qp#3{?%`{(^tP~I<7o|w~NBRBV(kRr1$IGuLqvBmu)$f|Yf?cYieh=u;Wq|Lb# zuV65H`)^WUWlR&1a*&nQ6@dXH!Fq@E8aEwJZ4)U-LYhh%Qf_`n24OA4;zI5T|6sCP zxkpH8LoCF9bF(2>)VFHwE?0{nk2f*2{;2yrcmf(iZbRDL(=L1lU+3O(%D0T#yf1HZ zE9Ja1n^SkU^*T1m<;Sw6<*Vs7nVV)fZJBVQ0uCkLng8tA;vaQ8z7K-WjjEBx25pXmVJA+vez8kPS|B4 z^=GZk)qvdp^?v!K?B!D*yhFOX3^%ezt)4nDbHVga;mUmWnyf!CedDLv7P7oVDAFs+JyxWySN&L|FH+dHC0^DR%VCUU@~UkF!R> zaKG~S{1ktUsn_jSN%3WQtE%z=I+Gl#QrDQV+rWdUmtMhjq@DO48y*E$P|K-Xn%_y} zzE;FlkRQzT>N{LmRfqJLeuvX20BWLWxi9Q+<3`Yr=( z>d4Mojv0HR#QKmqIV4E-zO z-+Sz6&){;kfh{jY#`)P5bD0SC*%Gq7`{seuVFKpy%sOZ={9A+f4G!()Sj?NT8+CoV zKU#mMRm}|+xF^pu9ZcRL4nBVqGboC;LKPMbT`(KS=*nW#VR_)dCsevn*>59y_nJtV z&Ei`ecJ=nM*;)~Yx2;WZ%CF1LBCL)1G{YMnh%!<0ZkIZ^0US*Kd^8Lk7zo5J30xk- zQ|G~%fpdNLvI;G%KH_#kEcU;NAiOlZmj;h$saG!%P<_PC?1_M<`r8iK zZJTKu8owd%q`7oesmYi33UD^RTALybHO3+Bu2+kko`f;U=St;07K_~+D3%o^Umux5 zAfHZv6+Lrm?o8BX2;_1ynCJRyj|gC;Vzx4J*A_nl2E+do=Z~CqML^|mrB{DuMRiN6 z^4HCRhEIH?YMKr99M{tPYPm*kgiV1!P8I%Q>*S6716}98Wq`9|!nbH6L@vUCn6trN zvTwSr4P~|6UB|%%-W5^d8ns#O9QZRNVQxCV0^IfApCndlZLlt*1g$DBa7x(@1dG5k>e4^W%B+fZw93<5k1(Ul^I=y^7gGI*QpV8VJohuI2SWrdOd6v* z5*a}nbFgaWKbx{QNG$5md^N6lc16`Fg@#L5g8@U~_PWGlVShNK&nNMpg54?AU$aYDL*On8n{flx7hM1&%2T#a8 z*e1C@`#g7>B!%YQmCSxKFoU`0BK|uKHe%%1wevND8Xe*%>ls=b&7L0u_8szI9rz5b zt#+5}l-#x*(#p9Vg4e@Te8-clEf$5YQ*~QRj2}qM|Gm$K#kZV~?l!q&5jJQ3J-EH` zjINT$0Ba{f3v`!%9~^#LI|4jqnYYKo#Hf7&gR&A*Ur3;V1AqP%QjNB9Yy4PpKkNZj^mgYRWQ-)`I85r9%+GW%(~-< zUdP^9Ki`He(wvFw$wmwJ`sV@!|M3>*jK619$x{+{3K#X!*yCQKhEIRM;0hBlje2+I zmC-d`WP&oM-X?A5M?~>>UtcNwL3dW%o;!0)bQ+@rJfw!udze>T^oMy85!^^`ousC)4r7(nYUsgeV_G?xC*-(?-@0=i7O2az6PUSR`sbNk* zJKHOWYtIi8Yf(7)^+#@!hHhAqU9FY4+*kg0Ir<2uT~+w-S6#_{KncBcQ4%1zu#d95&rIOG=|GY};B$@yX*oe!N3i_MgpVu*A(*jJM@4-y_A(yP6j&ZtXQ0J71TS zecU9m48~+y(XImLcXZ)3AqdUO-$;pUVvQW8Y`JcYB9Sm3ina07&ZEKU=2yDtjfF#6 zk2YMJ?-Ts;*;h%tiKWJ(Yc6$VG0|=Db&vE0;{K2~a}B!uc%28?6Z?F*-g>{Dd*lVe z11=syb(N;(EyM-apkL`-@$6XNa{e$O+85u9w4^N_ewltX z&ZJRL)XO$*wXs(U8Hiko>17|$qh(cN|GPmQT5mr*xXyvvQLy3BY3 zR?WZhJ|*msYyLRyp7x^^0cIMXSz3@Sy$;K>LlcXiwnGl$-?7v)W&YmrfoI@Ox*e_! z1Sa-E^9<8gfAf-I%Fb_t%X%GI6@2yEQJQRhRTbxeia-1ZL(KR6OmsGj#v{#O2LPk-5+B@V*7~P+<9&u36)|8s+90Bhy_>+E=#bFHr-j zTY1p&8rPoK?sXv)YF%nKbN1|Q!Iu{W*S7&57Z1GTWLxv9k=!|VhH4vMCi~T8GB%xR zzghR1>(Yc&JmHNoRiQLzB-Mo~^Es087S@M?ZCAc=*de!td-YUi50a3P})sz=MwL<6J*WZIR~wK#U`b&kk%a~ zz=c5|%CZbo9Z7rt_edYm$2!HYmU1zMnmg((gq81IH?AL00)P!#nSB{mGCIfKl#`e%YhOd6v2Yu8C zjoSky^J?=;#H;AZ`QB$!wlFb*&HqX}pCOoj%M{m7*bHl46)lI|TTmVAFAlA*p%U)m zIJ!&>b6=M)c{`R^&v(`Hct+J0PMpS%nYzwKKSB7$rDiPd{G&SbyF++p#wnS!I(-Q5 zF-L!@WRESVLxw4&Rx-8Qir|gmP^(uriWA-m zMXXOH&=7hH%NY6V_nVXWtiDjwgR|(Vl?Z*`IHN2<6Mqms5|b3jO)(sfGAObxzju*J zNt*ez4SztiCY2O*o1qu~5B_d+m=am-`qcSf$G@`%6q}dFxaLR=jdm4eMv9}^XJmQ{ zd+k_EM$24zoZ;}LHdbM@p}A-iK0R%*iay!DXTWUPA0NF+NXgH+g5AFupUrrLGxFu` zqEHV}x8|%uIIFm<6>F7Q`%pKki9DBBMB&|* zsy(i!Ax4D9pIQ?CaWpd5>mZ`enUWn-7_YevO)QMa?6iPzy8X&NWWDPunmBd4k9~9+ zBeF!8$j-IRX+O;~8e@g1Objv=ICRAcvwR_NB)h45#yH{U>a)$cTQVFA%+oVl1S$Os zpEgqJta^gPNJ7L4%_dw)3ZV5DMe@aOdEf!KP(a(K@c@uC9Em^0>T+BCNGqCSR+ z4Yug2yl%*RP_~_{=A%0L^m!Z0p`oo$Hj6?i9(CfLn2T{MHXx@QDJw zGyts+ZkRsd6E){Hq*11t~L`}t(Q0ts57w?z-GAcq$w-Z3p|AT_{~eJnVrSm+?ng*vt_My{EAudH3*=mJr{LPkK4$ID3u&3A zzg>vo(q?ru#qJ@>(nQjpg(bvfJUuwCE&UN;?bE})28asM;zN?@VDnW|>*(PxEO(?j z=h~Rgo`Aq?MJ{-!lJ}t-Vs(ji+WIp(X~~ z@(G)QZNKN_4Oe}OL9B_5NF*Ja9PDbHjaQ#tJ?Zyc#qPD89X@vVWSd$y^hyw$BQ3-I zaPh`PY+|a^tRpqHa8NE&J#t*GGuL)jaLYXdQz!J(Sl5UOtnhA{ z)S=ki<=9NB7ig3Z)tRysN|lA#{>26!O{Gat*&k{1Hl$fobJj-7h9h|wr6{`1^(sseDp+bBCHfZbjs4KV5RfOM`gmq1 zcWNY$V(y);(EY+ncp7rH{zfGw{K>b|1#Kor6(dml3ZR;bY@gpM?CYkh=}<9)3vI60 zy`+3Z_Un2-L2|RHme7ii`Iw3!RU{S|6MI5(ioZ46X7|vT3hB0Jvp4LSdLES@D?WMT zG0w}?dpp+SrclODgwNuAeG>8FDbcEd`0dW|&)WvH2Q<%w9w+7eNL@a;lTXHLkK_?D zzRYVXvG3?PhS!_rA>j5+bk)f%X)}X`Pqx}}m_{Ds9D$?E)R?+Q7|#Q4H!+4wj@Z=m zV;3Im#jN0B1N_^a{C6U=CV?A4MVEt8yHE_7`_k0%J1$kd=6L zs?2yHP|2CVbrhP4&Z8GJ2d4TW2exb@<1D|uTR>bY4V1_^-qv?QN<3og)V{sAyXMmt zpbgcWpyu-%3SHh%6d`t&_un52&EgApPu0w?F&f!(^9FH)=1?8)pn(=eFImWQWRVj9mZgjz*yA zI_*2W?ck@FoWqRzP^YJT@prPhbxr>^oF5O;kh@Vq1R}2!#3%SE-RvK(b}pKd=CO7# z@NGrek!@=?8Vw9N*DF9QA_0OvmF^PX2pM>u@#2hy+Z-q1bf!dGRXnrH_F*sT(3t1Z{awS4Y)<4j3NU20NvoP$m zX#|2|=qJOL#A^g;Dab)td;l-$^~FOJ;pLL`;I;em2eTzA4J1<<2s(NL#elIuAQH|J zZyWh{d@Vo)!6YZ9oC2RD`4w>hl&va6S&#lQFWTZ??B^d!jlk=Ton zgw9Wf#Sl*i{^Gt$mqmzCan9AEf3`@3zkjxz2)J65YxQU^C+^#Wmw5E4bTh3YdeHVZ zuRROP$6S$>W`E@<$VRB$wpP%=8o*m22@1|`l1p<@ z&07!D_d^wx5<$ur3?Bl~(we^dQ`JpHjl2aAD5w3k=tsYm4z4``u34^CxPJg7INvjC zz^IuJmFovc;QBx@(D=iOjhd0?J;|$gcjBdw-l@_I3^glq>GT9a639P_dJhSfK|0w$ z5j=b^>7ZPP_;J#;ksN=zsd}20$wlPQWwZ{10z$N3y0 z!*Io%vapdN<0nk2TjDSU*8@xZa>C?1BbQJo%`;PNHa!Y^kFu^X|O< zdu-=h!HP)Wjhh)UeM@I>$e?scH5ywEAu#2xxiMYgUP@TwwZIsS@0xX6ohdS#y(vg4 z0qzFjL$?~^ihg8&m1`vm1n};w4MN1PGg5m~I=$A*e*mm6=o;5-S*HPzt4^oaWcA-s_ z`{-%_= zK_F`qkaFuZhH8B!ssQN|YKYVbF4Hx~xwg^+An-*%kUu!Nu!{C%t(!Kr@+#h=2c*?p zoB}v@2}gEFUy$dJ5+7p-zD}K+!KuBlY07@ixn*0li`Br3s4P^EzMI*-q*M3Y4@xWu zJw9g^s4;-QE?tK zW12x(i}$kjbwo6=9!tl>A#>K%E?MCbE5|a3G3MI}jWp1yjK{mT?FD!vyJ#?kvGN5G z`dd+GhLoYixreRZxXoZwkYcLHKp%eSBep2rPz=LGSqtsyV=K-2c*LbPWPXeIP$Rq7 zpan^H1xoHjmW@#wYTXR}0Du0Y+Q6kNIw5LfJM3}G*Nya*=D1tK>)lrgWo8$0ruLqY zb!MLK8YY%$^m4*KrpPwrG7;ZptqJmYsd`oPm4qv&#v=`=xbsx;;i@(2FWM(UzAF2~ zQOw(q7#;t-b*98IH-Oa4I)VAL)Er=>@n*DIuaN~P?fFcGhPk|j30_4xea|ip$_8ig zD7lAQg)qg^(kQ$?@U$q+@s$OpkvXk}<(om}`3V~RFb_944rq;Q~zGgKgW|*w=5j%bppQ9+)bRFO^CL2*J-!QyJNBH9YntmkOx!<2 z<#jD=rFb<7zWWXD_teTagxw967o=uyq?{ba@01zLKs|F%EI&Ukw3epa#z+ll4WKW^ zo14bNDMatDte;*0pn5PFh8{PnY{zLHdp^cJWT^Y`3|2P1;x@CFn26S!XW)SOIl2dg zv0l(eIL!0o??+d)YK39=w0?R?&ZDtd&$NFHMb_~m--A!!Uresmesmw-^8*1`V27;X z+Z;GT-dSh@=fjs!DRazeBnuTKaOHE-%{rXp$v>8_N3-G6D%dAu6y0T5mHAg>Neh$Y zu{8gNIXBnDr=3ir=q^?l++}pqLswT1Q&gI!rnanFIxttIW(J0aKOyZseQtx;r2pGY z_Da{g)P9&Zrt}>a~(u+ z@BO4{Yk9MUOLfe177I+bo4xeWq__P{joHYl>hzb#Dh?FD23L8vw(FKnxuoR^8{Rzo zp5^r&XE9lHmVbH(Ycd>MnRm{=C_jV>0t(0Nt#OoHapcJ*(Vc;)%Cgs^MpbZeTgEg>L&l{+=Mx{#~x8?ZzCzB49!Mj?s=E#QK3mf8uDFQ(;?ZCw! zAD&XFF~6LIb=^O9#R=7jY^QBM2g}MrYo?dmR_tZ%`w~MZAdhdG3DFJjYK% zJ=Pn$OJ$$!_d!=;&QT~gcTzzSFx3lJ8(7G9d-1Z4eK7IB3^YVxE<~ON^HrVDDQhb@ ziNjoznYelyanc+1q)K?mD*GCCEJkggjCwI=+s+yJR)w*gaar=7JrJ~8M|Q<@)eueTGW5`hm6{1T>KC_gmQeWzGCt=9Fu>w~oC z-9Q1}SAtT4#DfMFXR1$79~+D1-1bKf@22x#j9!n1I7pmKo^{<(VE0vi5@^bwAQEH+ zNiIGCVwa)PpxZT;CfEFnKs@iH1Uc1T%hak)9N)xx4t^<8NB{|6&&t{>i&~ zA3XeJFIY#&Mpznv4=;1)B=|`OVABz`S#=3CUAZTL!?{|Z>l^v=0FeMVSa(BmXEcv) z((-%^(Ad>3dGn0ByTjNCi=AuF3V&qPG_(oeb~1BqibFT)u;X;61;?}Bq*k4q1#}Bd z*)OQ>$9KlSUfkY%^DJr*)6_FrSOBovrFupIrd(o+6JT#?ar@rYpG)b_m*iFv>B&V1Wr4FDhn z@}I>P;LtVx?r!Q6fSMs|A&lHZ#uq>q%5Wnq@-Lh>vbYZ-{9q>%;s8}jaQGYW&b+m~ z4S?)*AiC*9$g6ib;7y-oUY|u5-kbN>Qba2OhiF~xVXzGdC;QhG^9~2zi}qTf-ndj_ zQfWqy1$7^dv9bhjUz2@Y`nlncuxyVitk|GK)2%|ZJ_z4c%;T%?=@>XhB7J=L;r80J zCxu334)*PhWw{;1(UI`=AlM#gD~bIkT6(!o+=MMN%#DG>$URm9h%?^-E(*!iDQ1UQjQqt!Uyx@Y8|A>xA5@a@U3e$D zAA-tEJr;}&DUxv;h>{+rWzjN!Y%{ddZteJ_UU5Y4{~cri{*~L^uSVVn!-H6){vshZ zt>`;3v}VuL_26x}^Z6Ij3}mDr{nqMxP42w4a0RiENi@x_A%_r)ZO!K#HvgatT0@F` zkK0S~g;3ybC+zG2=dw7a+V>pQ5TONG*$f&afNL(%^uB;-xU|k&fO}1?8%}_Bnq7ce z%&3PIaP{Yx~`@J70Pz;+qp{5D2e%b68jRxZr|F@Foed zUsG|hD=SOqHRqF81b~X4WR5$6LHw8onF@y`6fzG4wi76~!Z3#;CD|f!1zQTBRXWgs zgM5yc%)~ZyO`u@#n*CYb(7;QcQJXJ=*0(hnip=-WXrwZa(bvv6`9AH+^i(^mtSMeCm6Y*yPwkML52Zznz`)xQ?E? zMG0>XCkE3UTW5s_wh)4J994jBe=T0~?&Ib7rPE7o+G*9@PT0BJ56f|HUe*6PecnG9 zF}|v0Tu{G!bLw)xtLc;_*Yc{CWm;7KEJb%|pKw$A66zqa;lgf>O8E`w>J>);Ko@FDZ~;U=?_XeRN4A1r3Ye0OMi1jW zw?h)n;lEm1)(n&TIZ;lR*0O7By^!wM{Px)E-;nwr2lQC67cRZ@P0pxlu;rQ^&Zf>7 zl+c_Dg=kz}(wOOtJ+Ib0(mY6^$f`#sWM&RA`=3y^)gz7#MNEg}-2ppY^N89$ZU0rQoHyw#A*R)T_D;TRtS_|F{7r*I%> zjCAgl1Yj-B{3YuAFEIb2k<{Gp0VB$ux*##{Aqz7D*$$RLN71JYbOlM%x$LXDQ5tl9 zsB;4#a%$$YH+Sn7h|Y|1!iC?gPI~%GF7M0MJf+(`*(OVcl{To_1*ImG+%hNcy7*Tc zh_`k12@ZKO7Mvuv{jaav^%j_23mcF;mh!_XXb=?v-vfaZ->A3CE)48Iv4IW z#IlvpD7>GiY`tZ>%@40%;tYMenrxg(8i6)ZZ5I8aEkyjbyCZsS-1J@`J#0{$q5?Da zPvUcl?SMc+*2hAvKPa;&&Ibj|A9t>KW1*Th6!5YP`Xj4{{zv~ABsau6zolc%xNelX zf!^UvL9%JvzLa9;j2`CxhuuVaU?K3-UV-!@#JY{ZFXbw9?gR1;a2(x#sehuC7jW(g zp`G`WbS$CV#Z7lA^qN_%^7zX9;iGpLFX&S%W5=N6_!I^WOJNn>tV!$D`iR3VPo*p# zmk-hC+Gj)eZXOg)=SS#c7;)a18JHm^&bMrrv1tp33?yI8F1R88-i$c7}fjRS>JGmm{FpkIY)`2 z89XA&;qA>rJf-q5H*e`*_S`$xwCVNq>#U^-QU&Q!T`QpIPqNhzBlyLV`L}^OD~%^?tq?(pSyrpNo#WhqbcF z_w(zmdo|6CxU&4dIw;dyuhWAHT^9=r%Kt! z*8n%+oI$zlka@R>LH4Sk?;D^Sw3HjPmY;o>qdnj%b{ISE%E4TZAYC-~Xe#kC8jjYZ z6xLSk?>xea9nx8>xl)5^s4jcHOx(^(U0k0p%D7Du*~w!UL!iyq=9#6W;j`n>3@<2M zL69^hdc^o}vu5*BgDqzsHy1L!0rR=Lz#}wX7*KP2nl)8z>eH)2OYHV@9@ZM$BmTl# zk4Y@%J}y#0QLK*Hz@u+4s(mZM)#31^7ud;F66UcvoWo>2TK~oyiVrtB@x9#n9b6|{ zmYs#tD2c7G96#~xzj~8)7C{Ph*|Vu;{gO<%rULg^VYUuM9Ao$hhlovTyDQ*!aXVbX zkmFw7M5D$w`U|yh&B+T2LYZ(kZn7g&L3jWfGCf{>=?47xmm_FcRnCqsu5Og>z#N7m zM-iwQYA6uf;%ase@zzl^OQ%*=b3*F`O^jjpw(?!=teq@#cZ8;+D2+igZ)b6_)IrT> zd!N9+Pe`qrY^_Y8AfNP`Z&&8^g}Nb<+fo@IhH)c3Wyc3O6{tNnn?~1Orh14i z=^Z~d;G=PrDyJK;GO4^?;TS8G5_f;4PERGB!O=w4>*rJ1Wjpb+Q$6;YQ>NLY+AkN( zvKX7Y(rd+M$zPnm!)@pa%qvL3Iy1f_w2wMP+drw`O6PituP{vjnukCJ-*pVGD|V_u zK41v|Zm>9!H@6d{-+gXkXtZg5=GmDN5Vmf;m9}(&M$JIFuJD6bLJ)_I$0|6ZM zVUKTyh!P}5ffJ`Ve`BOrBgZFa68v<-YF|1JmEr2;$I1&7p*`5ggAY#HM4~#^AiddL z^yia>LLa)Z2~FNictOZVh>U4k!sU6-q2>17FeElu?}u7GKkmGJ+7*@ahpnPXxiDQB zXdk20171w!mJ@OH%$5tC_+(LRN*nnZ{3UKXJILunOF$CJ+_NE|35nsvL^BUlxFX$$ zI8Esa~#7X3hPAMuBT*z>OcS)TI7Hd_{Ke zH6jz2Y?y|67?}HnF{)@-ww=>UcRY5#%i9f`#pr>41&vT|$W%icFB^?nrq|8<8^5Sk z)<)S*E(SayCRCHc#L-L2tdfP@`K`3mJYe|z!ywE_W>S&Rte4JnC@3&Q3iXMI(NbFasFGP)^!vpRf)&tQ(1)Q>xUNg|q4|u9@ZOSSl~A9+bJ+ zKHa7lq#ER=7x_!h{c;W$?8Amc*DKe zns&B%pzYgw5svD0gQ(7KYPsA%=$p|%Z{Kb3CL%RE!l%wocp=j^FstnAn0enMFC5^eoRt7cNbpWuRV1q1SOY$Z?(S<_=xi$8BG5<#Xpx zKxu^p&XsC}ajCW~$hsnb?wf3Nzd_C$Cbow)^a=kgT)a+N%}d`NOdZ2;CbFgdP2oCB zQMdu@AW`aD;4=UT5S=v|Rj`FNBT$n7GMEDbZBK!Pzw<{pnH8Ey`eTKcO%rIqhZ^{Y8QEwDb2I)AD^kCEASk~ zqeyh>M2>0mM2L6O#Aq;{DY`p|#+X#GPmqqB6#lb|CZ3Jgr-$96;h4Oo_GlFE^~NkR z#lZSCZfEuCz#)BE;%Mvvl00lE+|-t1J~}IG>l4U-Oatp(N!DF(j3?>f80Hlj`|lME zQPE-~G(?F?HE@Auo$I89jLpxm>u+rXX&i0zlId*=DZbD4`590`QU#6Vg9~b6M&YU< z9b-(u!9+4}Uk+)(V7Qr8R2P=oc|JXrvS+cOI`ImwW$H!IpJhQa-)Ogn61UL3iGFz+ zDP*7ycCflML+g`6iqBD@lJq1L9=4Q!y&KvmNI+C3G3;MdV>zN8>QD(7Ey(Z!(OZ>YADZ})}&r3 z2%IYPc{$bSh~)Wom92QbQ#TOklbr&S`xgcgQ}YsI=t6D_D;FGl8xq67w+IWYla z3kUiHTYA=ZAZ%_Pz-#_NZXQq^)!F9N2@-anjUkJC$NKkXXGO1Ua9(N`7^VrLt}&&M z2=&;fvNyU3G#utAw2#|RO*Se82|u)&YO&JL9$#5qYcrdr4|R7Lg_Tg-;kOe}HVt0Z zajBMgBKkztEpwAE6ODH<^a-iw5lef#MeWS$%a(N^0(QLA{(;x$I!m!kdW}$8baDLH z9@-J~gRu#s&?8tX?KDa#-$gAQV=e(p$%nx|PZYPLo2Jt6};*b5}`rYQy!#t&| zW7zCCi{8Bhf>{jSc16m61q3mULv%f}kL zMJ$s8Wn!}qW(T2Os6K`+6ZvR}j^P_$#MJr7>oeu%LbeNdIcY-iV9xl;6&5PKFeY1r z=ZI&*?uYUsg^ZYs@p$ZnrgdE4$HJKv|Ug%4EgjINIKn3^#q2 z1wXKC?}xRd;ixal8Dk`QBK?Ahl{M8r4I;}{#*FCk)dHzE-5)>j>h28|?{OK3^1#gvGs(8( z_}5=p%b6ISsOV)Swny&{jgER-uzWS|sx@M}z>*`pE-;ZO?1?s#zI}u2HS4CcHnTX6J1wyqjZW!VhKh&&HF_7qiZ8)>R868^9q#mq*E3Kn;L^GEe>ofg@rR~70Xi)x z$$B7FU8eZu`?%;f1o9Zv(@3w9WRJRS@Z4`ArL(^D3CPA+2a&uIvaM@BkgWjr0HaGd zDi5S>yW5g_mYg419uG22KWSFz?E<3Y>2Dz0WNqTM^B`I8Zw(E^^G%Dx=L>GSCQ03$ zeL#yT-du51uL^rFDQvnHz?TQN29ELWuZXageF{+JmLJX^CJWTcoeC9{;Hku9D4FUl9AdsM3%dx^s^P(*WUWLBY z`9XIrA!5%U^an)uXO6z#vTgSKOq)Q#WpN{j!*9;LYKQo`YU#Ar(-u6r?i#+;VV9gv zC5T<;SxM`a;@WfDkV>drLxE)YPVBO{UmH z;xPYSI;1Thf}uLceH1j9IL8Q$Y(C}?pTfky3ZVgWv=XjbLFMG2vK5Srtmo_Dv$j2> zl_;`U^UDKfra25ZXN}rK#*0T0sofe2>E-h6Z(LLB6R+Q<3#**W8Tv zJ^$)e0(P>x^Fee{KFr{}PRhxht#vh4{1IA)xA&9Du#yx<#CO)(#;6Z66TEBYesz@W zZXli-!rJ1!><9IUgut`{er#2BaI%Q;EwgNue+f!cux*TFD>>pgyG4_~J%{-AO;KXL z{Ma(~=u6z5l5n-oWX?11)gk-*Rogu^E3Km4>1Qg)wo4|4UyvwIvgr92>BBQOyoT=e zA#$I>az@_~>gUyDCgy|iG+U#E`_ud)RQ_<{;^c{<>rt7N4gPg6<)h8_TN_uSgS% zK4y}9yE{A1*&s;Sbh+M^wxE*Qp$DYl<;xkinG6usP_g;WJ`ryY>YBrqrW(6;m&ZRQ zWxFGM#C=jwtmt&G)xh9CzSvxM#6rhY+FaUfn`}b?OuT|U9ftJrB-d*q=- z1)t+Jn=S-ZxxU?8aVdjv%dO%iaJvd!c0X1789$h$;DR~xSqGC@=0ujY zcM!}X)D)ES-At88p^$pu1Kso(C>)6kx6K$J%P+*q2IuxkT%y5+al;m(K9GffJa;E& z*`Um*#XZZZnce)K<}KyK&+$TeA;&lKd;j(5+7xMA{Uxqcnm0LrB8;p6?ULvPs4(KL-M5m7O8MdORA zY`^US4M(3KbWN&h+j01t3MU@K{vffcfiQW*z%4X%<9b7BODA2)mC+|u(D{F^7>o7Pw8;)!{^DfDj*tuBlFx$Tim#B zx}1B&)eMkYwO&a(jHw&WjP7c!_$AU?pm;~rr8F-d zB^DL@IERusGe$FoM5WVy3ek1_LaTdRX=E%}KCMu_PxfF5!+%6oVoA^MP7~gI!~PfY zX22XoKV&`u7rby-qKfPR&a1m72#(L~?<5{D_@CnRDG&{OCLsyP^*hFI4r^ ztbEn=#!f$~U!8LdjeivK$BuZO5t~G1FJ8wZ<8x1EqC^{GXQ(y8INpZ%2wX9Dg$E`7 zXq&@+R&?%sbiHX2KDp>&T(b(rBJ;g+Mptg=QM9R}F#%E(B`hn?Ru&o0{d`8>*VeDD z$k4oZ*N>1hEH-O9yex-}vRY!=9<5oqlHHHPD2&D$G*Bj@eJA*~n&XRYW5@;;eFeqK z!jALdghrwG+TpCj{-RG42(ej}xDGzWkA58^ppm|%3x;0A2#J_SUc~$#Iut~RdPnp1 zW>XEOD7z|-8DdB(&tOdPP8-dlyQfW}7Z)kakwsaJDG~PJ_zEa47j#@2LjpF}Q6;|3 z@H%F=jT;`%3#lG9+D-O&^h?C$C9F4N?S+xiPZ?f0BlA(fKHgWW7JZ0>3am~1hGl9W zVWV>^E{cbxyh*l)u+~dhkkipgF(h@ha1bl`{i2N&rYJ3od}y|a{B%(?7~sDFm^-_~Hl!3a z3!GMc&r(1N!Zfv+y(c@J!fV>a@AmPFV`0o+Zue(Z6XS9iRT`r!Aw>2vyg~0dPP$33 zST2tz*J(Y*#l@UD#s4#&=N<2Z9ox~a$ZCLvo2bYjdH9>q9H4~>cX6W!rMoc&Q3fdH*9;uwVYexF6OT1s&8dFKwk(Dne7q}{QhUD)-P}}T|6K7!9 z^f_Um3{6dR%2-8Hjws6^q2rE1LndH1Dh_;M{RePihwP5YsTvnkyw3^fU;*^XOM{yr z1LR`8?=nuv{=5rMX=1|`?9USN$yp%n2{%g@I@)ODlV2nol_|~};8x4FQ>iV8zCR3k zD$}Hm$AYiEi-~VSt~mRO2E;9TxpU17Ig0vBVz`kg)~qT^6q2^U(zX`EQld03eP?Np zp<2fZyRwHS7zubunMBH)7Io zmEOb{SJ~0P38}9)YGutUL&cme8Jj>=Qtmb9kY|I$NbU6hg)`hNfK`mXEy zVtQxheV^w%=iKMM@8h|Z62w2*m{2^hBa$Yb*zth5m=#kZc#qrK3H!xJkKN1p!Y?P{ z_{uE{CZ#BDl9gv@;baZce@9h6@ktXp)Vprx*mq+v{!S>Qx!I}Y?I@8XOCnF0Z%wgr z+lz?#BMO)h@2y0QkHo3o*||+gGDjQ=r#vc5Jn8Z0|ClNI42n!1Xp>oTv=N{!Nxr-~ zyciS^YA=yGSIE4h5xku`*1p^B0(Fx@ig2v)6ZvMov6k%q%Xsa=fsw@nl`g`1TA*OA zyk;3UqH$0&AK_r9*BaWJLQZVx^MJ?^Lak5tqbp88+rE6Q^mAbb6AwwY+%VRm6{4;HG`^QZydUTu>}M_D3n0vbA-2}o8F+& zxyU^5>9V{ueA{wxYq@)_iy0)c?{6@nybV|__nyqHy+%Doo+qbh1EYlHo&ek!yG*7Q zq}Y3xRSaY{SgP!;NTMvVX<+$z4Kwd=QAKNJ7f^fB@3wjVSM2~>$qvdNy>omy|86@T zl`L+(ujn!Is_TOaC^m$ngGwK6I|f%We1R0J3VN?0lR=5>Y|t>|&O;nu42$qGpWDWn ze5g-X5VopC3RJqKU#A$p;esv+DVw%zFM?B+B~<@eO6crH9?+_cG>1pOJqU9bWIa7d z`o0{Tyq}xoDao4WT~@UlC~EqCjBif3YrTDoE`#6l1Za@G7he+iOhKn`#;>QjnFz! zQhW0jOM|Uswq<{om(Z5DhWHAE7^d%rd68z1jUI`#Pq@`8lCo{JQqkgY z*?NTc5RFS^vO5R!;25Ju#HBi@Dx=a&k|6A(=IEiKk|HroBg!8UZSHluIMpk@w~4HD z=SaWiG4O{lIC-u zH|QFf{~7wXOU>{54;XZi-TgG;`lg>Dq9_YYANBNGumTRH%34;Eo{Q$(#P8tdI(c|0 zj9?3uzr1#LkO)$EUxr7YzJq_34+Wg2QPfQCCPT%S2bIFE@1U<5qpl!c8NdT7d^)-q zKl|+|l(!)vnLC~OU1rs5I~T#&=wF#H^o8k9b9g+xOBNAq%rVxKJ08uIXt{5Nf__tJ zG(y-5X@p<`s&nO+IgrUqfu0*d916w7l(s(H2^6e}+JnKEi+UT}3k3byiN8GLU)-;J zE2~K{#(Y0oZTPYfr#?1K&T!KuqK0?oy-T0uvIjZtKFi)oAh}>`b@D04`f`st7UWY( zZcle6{rO<+fqr7!a`X30#YwH9p7Zpv-L@;m`{Sfj*Nt>WS?yT~OM z_nkgE3uDDmj#WtA9aq53oIma2O1je%2c5ZMYT3|9>R1Gs z90g#oJ|%|r?UoIA!$XA{2z9db9-vd7&^OB7f6HTR(Q*L%gVVE66ZzGK1O=u3`>M4J`|nc_w?z{0 zM!wtDcJ%q^*<_uGslGoIe01ZCgC%+V-;xw@-|ZskTcQ#_KKpgbeyMG~nDp2~oFkrm z?e$YfgTBNcf2P9Oh31d!i607*_S;A1DF|3!QE}sHrY>$6a@nOXBF`z^djn`|>q0EW z)K!r)bBV;A^_E8Ar`hB@_SqoN`rZdWk z)hXywu`vVP-y8m95URK59fsl@sCo#i7LitkfDHpaB%LV@=1TuqNMPqvtPMxd5C|;5 zQ>b}nWk4gGaoZFj#(m z5&V4)A%;6w;P48WgV=h|LInBPA?k3OcC=Z=jwQ8^6994XEjALl;|#P2=s z#^Ci7<6t{dE+wWEE)Xz%$)48Y^M<4lQ{69clF-fX(={^yKv~*tiEbW8``5#G^j|Zc z76!r$Ro|Mi8xWI(@bRW*ksgOf-~sdjFu+gZ9Vw4fG&KtI5Ttc~FW{OPB6rRv7(9H! znvnNfKB{=-dGxjQK%TPgrrQH1I6j(4?6m%Z7Ws1_5zC1(ZykiR#M@y)_($UG(SiY) z#i!jNz0G8tJ;4V0#ppJy>vFXWQ{5-)XeB@D=M~WD$+Z~H9HFK0V3fZSFg=yk=-nx! zj?|1RlbEgE-sjP(^2V-GSHc$)%a{r?qeg!w3^CLr=2E@rCJ*73oXZF5Jv|1txrhaW z)Z}CLjQ1XnawP-5d}?B)CI!JOUXAV%1;pcStwYR@0Q!-fC}Ueq&$l@F+=DGKUZ0aF_ms{jHg|EI3|EAWHU;|!*KO|kxoFY|U~i&RnL zKMFIcRXuN-TUn#zU1Ex+PKF8WM@}K^K;+xIaBa@L-mj;3T{Udb*kCN0o|ydV-|ku^ z{^RbMja_lOAoW#?LGQ&emzv^A%9p$45R^@MYRHo5_Ja#0TK@oFRPi1J{B_?r{Xi;@ zfAG%%@RM$W1N7(-=v$)B0l;6_#INRk1hmCt{WH-jET*bfOOrB+*Odp+FZ48OhXHsV zvX>KHdVNOityx6CAr+Q% zjHV@+5N`BlLImzWw*eJ`Jtkhz5C213vnEU3Wa_U5)+>LeY|sBfSYAuY!-psQ4JZ9szdrp zyB(=xCf1IsyWk=p)CIxC3|?FUCQq5aAph}3j#2e(7TNBV?)XBA+_hs%f9N(xJGjP{ zf4dI_L@)~48fA&q8h-QgolkEkFI8yQnT#%=-#Ap)&zrCR8eCKY=H<

Pw4WQaz+Q z*$ydpw8i19--nNlxsrc|eg4kiQFx%JXqI5*^Jf*2TLXddpzerBNj&-qCG~i*T9&_{ zTw8#rSxwgySt(x1f%#(QX=_(PO21={fk$>qCesSM5`7Q+Y@VErO6cHto~2zERJLOK z$KmpezF2C&o8}LdZz_G6=W@TMVTWM@ZQr5TJ+`=*6MN;KJraZ<=tH~|g&4Sx6|$}Q zYQp!&PgqeX?(r^6=f^fjP(%tMj}Fy1+C6*gw<4(Kj^W9|@PlQbd!r&?_yYf2jNo348=j=d8Gpy8sOCD0Cye; ztzOBn6jAArCjJUp5fF)TutdlksHe@|0=Ft>Wz@y8#M8h<5Vht00H&&{oWz=ExG?r$ zaAC6!lmVu@H_j3`{-D4@@!}O=J-*d!hi&>>C}&AL0{IB9a*L-v!aIP-6}D`lBw~n0 zYPAL5yYR0M!W@dR2M4&vh+ZtWX&Ffq*YQUWLb82J^Sx z8KD>YT&?M!T9-UE$42^wPeTjML`3y+D&L zoUr%0H?or14;6(VJ%GHgxJhUossYO5{r%DWU5`pO}^ z%+0Ioyu@I~xEf6L5k6dZ@59*m!wWP5v-R4#dB<}Zbk;;u&U3RSlIv^RTvajfWV@Cf zooO|^65}mWn{Tv$d*a|%an*HBwTM}I>^<%*)+U$X)Z|-7PN4h8E*^jqY$c`&>zvwc zBg;W!p7BjpjAK=}-oLIc&n+k;?i38{=3h%=S8CP)#GsJ8i&XHJ3TytZq6@E{L{~Gm z#8La3*$@rTazt@FvdmD|m64VAdzCV2HtlB?qB*^$zbiD-<6(SE3T_kX=6&+FO(=f| zb!;m82Q@!>p+3YSa+`)MU)UdrDEzOW7%P2*~W0nRObiQ973ULT8Fscm7egE zD;KM9ugJ`4f%%+6D7IrGOrOvExr}heM!W{4xEEkUhC&-#S0K{`anD5h<|s=%gqhCJ z{fM+VL)Yp2MoZT&Q)q*E9<6zjy_R+#KFM`agzc?4VT$}b1QGKmL@#zg=+ul7g>(?V zV;`%6`fiAkjhYwWWJMW{P4u!3IEugU$QBF{McxRS!h1nnguJU~$TK8AgMXHg_zoG+ zR+RhpA|1G)|Bh!=sMZdTaTY;c zj!2xWo4ZtoQ3u-qB+)&$(IbcWu8uTC;e9kgFOLr>tr0+>t|BFYK!yU6#HMF}?AZ|V z{2l3vAas%_ziL*)A6II_hf23Vj&e`$DQozkc>fN>0bs+J^xobx$ngn^B@wtTUe8;< zO$r_o=K?j%0rbpocT(03(K81gJ&7{t=$5lSC>O7%16uOuJ11A(avOL|3x71nMGn6U z7Ng*+yB%&s_lezE7`tkUwz+0o!Asbwm|eK|_Ix@~qeC4`Sg$OM-IgM#Bz3#72Ct6E zl}`e*M5*%zGs$eK$?~Td?SN?q&(pqj-kG!`m=0`sa*Mv45TvHRVw9qn@3a3s@L2ld z3j!(lZgu6lygdbNZEW$g%`w8${NBi9;cVGGQ+OX(Wcsr5-;I8*qP-(tVNa4?kWR4A zbK11Pw?kxg$YEJ{@P87bgBs@Ab~&699ZB#sOix&7z}?yCPy;Bsqm}jy$=E`?JK*?0 z@_wm(;~a0Dy$yT@TkhTlLcp!eAN;`RZFaj+F<>`(`O6&!^iBI%{rJh^aM(cCkPf~2 z{fWKS1o_=Jb@(j$a(PDJUcGT!KATMSzrl=!BE-BMSi3Y zxfBh%4278fH96jEY9w2XI+4GF50obVs0gS?cdTKjgrmS{H_f%<{F?WzPMms8WQZDG z9LaIC5twcFc+;1N_XVmq3SK&rS&z@-nd60WyDe!Y*XD}U{_XUd13pB zBshe_niN67QY9H$Axa7qP8Wq2g?pzivDLu_hga`_8pM4&QqJtO0R5CkWHFKg@!V(U zfE|aJ2%u2v>a8Gsy2lPLvdcVzY`G1b2&Eabs0wu{3iS)F&*|U-i8SO8gns!b`st5U zc&4Xh>~_4z&FK5le?9Ze79=v?i%2qA)K?~&H_sF=&8**lE^VM~P02w414n|3hG^A3 z*(2pP(qu%bN8VAn<5w<6xm$x+CT!UpY`MNQ>g+3p)ME$vB@nqJ3MKZjoN&T)*ZnY& z!oPvMTZ~%AleTyj!VUYUr~H3dZXfGbHmo1y7Jre7`my1$4O7w&?GM7vV`|!Wq!feVve6K;VLu1KH`Jhz$*VwY81p#VV)yC>y6cKv)iK=a5@} zJ@he9Fx2Id8YKl1&%b*mw?kIX9aO^_B89+NreZJizEViz!LRWb=43fg5(p@RSK4?` zD0c&};-);Z3LW%+ITD-b74$ZGq}yJytn{H=rg`en{BcR?^}||a%j1`9*7A;5u9~fB zYR?9zB(C35>}Hh2y9Z6lv{$aJk1WfyXIjll5S8xuGlb8TVQ+g%8_}CPt=4AT{F(9H z9?aSIzvurR7r>pAdlD;iiJKC&{Lx=ojVqpPzn&T>vQVXxOpJH^y@*>|_gwvaux^Y z=8JdRp*HhCl;pBofWRA16~}#_N}C>^w=#0u?cof@Lu+X&?eeb8?m@wu$y^sbFpu!0 zW0M@~Xd4_uUwZvIFHvStdY*A$X8iz%d(|v9F)dQAZbV3*I-e-#!E`(Ns%e&Y=3#1I z3vFf(CXW+yj1%Ln16EP|*@Fj}34UwK=plm{;eK*kcon_Ku|pk4JBDD2WSvRd-e-}NtZopSP6GKx$(IPXupDS(r^5!J`Xj9M9=0QM#})<3!A@6K2uOzMc1 zD0Xh$^HR6F8X@gd{8IGAh4`B->~VoQYDwBckvce+%+=y$v-rTt6hU{IXQ>Fo} zv`PFzEgKLQ9-n8fe%3aS{=Gb7>PjBpCS9|7keD{WKSV4_ENOW+G@nHFSh3GsPt(6R zHe90Cu!5z=R<2f&b=HK(=4rM#3-Q#nL$`e4f^$(Oe!VrLz_AFr3)12HtDXO?fsX(pS2vQBF{ zBzokcesl>bS&9%E@*xnbQo0QaxegN7rt~0L>$(e`a0+Z3w`|l}$LK~_xpd569%8y#-y0%s zp*_CqVy@V>-tm^ zr&iPjX_E8+gMOpZfx&ImFr0NIN*Wu8w<_kx9 zlO)_2=O58>xdSP9>Y7Wt-1!HN!N1%Gwxvi7TUZWUN`J99`SfD2N}G?ZO{I$M;E#Ht zC8tu?!5I%97pz%Q_h-lMsyBVRU&(hJnB-S&nLZUqESwroRC3O#8;A^0(HflZ{RvG_ zLcM%p4_Q6G=Je%GT`o96P=@smkbBJuVnQJ3JU zm=Q#2X1w!w*iEc|BWKa;`()sUmQx9?Cn=(H@nVqbpI3WJl8kOKt#r_XkGm2dP}QPW z+#N!`_a(WUCS2wZ#>@r<_WdxN_DSzj>j8EjfEPZm(AB1O*8Rd~rn;SI^h4o&q=(YU z*Y^~@=*uy4jZ`(iC6tv1&FPkbtkL1{%GAeN<1}^&`uy0TaoX+ulhITw2aV4QM_SiP zc9@^&LZ740r*cqS_;}{V&2*W+bdz7Ft>QW;u z^jHP2JY!WD4CW&q$sbU!wW+CK-ANGNlPEPlRUf3&up&mC9H7~Ucems_;AV~DT;S72 zH+2}7qAT7la&=s}c(wZH4JFp)((`Sk@Z;6G{P9|CdrlFS9;(WepEOo3YYSlYSL$`n$7a{&D`caq z74GB)H(`^w?P*J1>j}=kC1$?phAq0DxR7*OV8m9*qmt;4W3fm%OR`CBxt^TZHKSZq zs1Me}RQI^v_yAQw3YqVIK!5fq!+C#P-@cZtrreq*-A?2e*34=wGjsdawnsPOUb!#$ z*F5fC?+l+cIgcJBo;*`)6pT&dY!VKRzA1X#b~iESeMgDcw4*&nCAg&e*v#y?T%F1x zrSU#N!Bc3}`b=RDo5McmA@Vs(CX)uM||+E z834J{HV33#p~<7OO_tI=&e+=(rJcQI^HW{|KYQ`08BvmA<7PAI^9Oa}h{T8uk2Mb9 zrcayoafzAl&pR@MhH~kr8djc4B|vkwU)vIZBgkrz)GvLPtjHS@#FGO&YClo#Pd$XR zk??uNpq8-%xCdvoFjp+}gg6ypf3oQlv{+GOya6b)4hNU1jl8q=5L6A(+Q%9ytC57> z4@D_b^8n_o=>GK@6B8pBz5IP@W$QtX291LeQ_7pvpV?9i+Sc$gn1mSL5!Ku)EE^?f z&|ZVuiMsqfV5;jMw4&8Z%qDF!ALmw<2$1qT~Dbg8`%PcJDhovg*l%Zq2@jlZp7 z^$Vb5p^k6UgGBi{d^adpRK7r@V^iK}5ShRwLk?|Jm@w@FN_I_e*XX_!>s!nQZ^zwQ z7aSPr)%{9`#W>u}^8qx<;Q4s^Lu4`15!lNC zqO}+NDf#@9Sk*b(-Xh~p?RPcpK{IZt_4Cqu433usXIF0P@Lhb~!m6G42%NvC1l({DBV*%S z9BopktfiCssJFQLgnM-!yqD!tEQJ{?Aqohkf5VhyNBUw^b!94eX{@Dd83mUqiHUI# zzG9iiPmtL@A+^et!gkjtB!oqBHcQ4$dRTf`-H#KUWP_2CLq; zTWJ#YZ;_g61NA`}UU4Y1C8U07!IfZH@3kV>8ngQchQ^G2mIE|Ad42At&e=}h?t@0Q zbwL>Q_c=LY(j{_j*}nAs$(?E^KufZt-b4CStJF89!N;r8&A3ykZn~hhC2=rpJiAC$ zy9EsPj1g;GY-Y7%DM>%+A8!oWPhL=HB*x4sv%Zx}=%fz6j+(dE7QlCQg9C4zaI?q& zG{IEQcljJ)zVHB3!%H~Y zq}vopDGzt1ytQKYz4OX@SiR(x*2rB%$Euy)V2+!}X~VA)M>(qt$ujCtuf+rKgP4?bpM@#UZfpV-3K`}0He zB59gs=>Y~szEXzW#p$;{Nk+j&tTai(F)4@%3? zH@ouY>W@aY zGU{S>^JZPXZ0jGJKOF+TUSTis(kH+Aal4L57k$i2z$ZcuLqf+B8yC=z^{VS*2k_-A zViqW^as`^xAC+XVS6l6n`kzO_7yb0ZXXOVx$mk^$Dls7tefcl6r8xr@dhH-&ac1rN z20{?LE^kJP8wU-S*hmU8ix;sbu1BxjUn3s1lB~_R&ec4 zN^q~(3IT1po8zE^U_zML(|g;Ww+(VNIxVqeI|!m6r&Lfsx-nyjC%OxPJFX*j!wF$t z_`X*lX>>m?92SaAkj_ON4*2FqWqU+7~6g!vIuCr`G{@g(Xy#5eoka zKjyl0=|M~tWlG0cFR^R=wdsXEjZTQ#>UjE8J(4UXY+ZWu#Yo713)DIU=2DgRs9#jjN}i6+D>s}3TUG) z+huKZ9b?}uQoSD&9DB|gTq66gy9ktYxlezMqOGSB)VyO07TbAQpGob?7V1bO{CSvg z!NFgN{q4sV4+{gjr}~nd8Qu)YCFjyQIr<%!f-b!94+A@s_U2zYU9mY2nmx0XK14qQ zqREMJu=pUvd7943b-_@D*>>I@A5 zkK#5A0+|aHYWr>*cPNKLfCU*tf(i*SB;Yoa;0zS)NJsEOl*oAiFHb7k0Qh#~PHZDW z2sqyaaNv1xef{QM^X;vXyTH8_MUn5I&hzVywzG1~vGQIz1gC4XdzFLTC-VDQXgf&p z3JO5mLSCH=B%#`n*DD|^i+9A&Srz( z(CJ2)Gv%*$vZl3V06FN#d{G6`BY~A@SNH;!$RcD-*F$~pBjT-vWesFpT@fJ5fN>Ug zFSi@y$qd{B)!LPN>{W*2VjpUuTwIKDfclJRnDSJ8{h*s{r~WcDh%YMUVT z)=Nng7gN2aFSa%B^GGROiF^}`jBQ#N>BI-KH(i1sEwSdA?J#%WetaHunS`*c7creu zNCAT)@hn@h{6!c6n{*100Dv-8LQaLJfkHAVX1ACTqEm7?O&33jC9F8bafykuT;EK2 z&E) ziBZQ)V_gl+>ykjZ;iP}`+mp4sF~Bnu**D=1UVfp5({%KH7crU#a`B(a8^vHDK1H z40YneKJoXS3-4yg${bSXY%NB5MZ0CSV5N^Cn;@B${l>Y1jcga;DJ|axssU_}c*00} zx&TgMG4OS#&#prKI#KH6w{vnc!_VL4o7dQA$6^X5Y}P*C?==xP-YlGXwu0Zn*=^Z6 z?mZf96K0orV1c9K4@Pft>OP%o=J2f&l30XiJ|hj`bFG`~0{(S=TVl0+^{Vlnl3SI3 zx`&txg%qo5(zSfX&6Vs9D&s!kP*Z@IDrqcpwUd%-eSqWbEK15iHdm7heoG%4j!c8H86PJ)K-WH^HfVw7& z97d>RWNXE@dLzG3-vft*y2K4tM}##8y#{bh{y}@^h#aEn!={b23Qm7`MMCshgrg!M z<*;P%-n;P9e;tBP=7?6&l#2r=6ABjFh|AUglM|6!aaR?s*z@cFtC6Uv5{H2i#|xP> z7ca(>g|<6YB)m+fjN1ji_oRcv`y-i$k3TDUQr(~FZuRDQH(J`(zT6!bxuU(z;!tnj z%aa7ZffK~d+v6T&t~u{f`c}GKhU7S?<^%5F;-#wA)O0LnQZLS2*{(dr%&j^~Zqi`7 zu-xE~OB1)VL9X8iGxXqT2OER$H?@C=vPbop9}*>NP<9aQOiM}6M5hv?eJyr&7xZJR zde%g-+r6vVzCOgRl!@A$qmQB0q`OhpMqkDln5ts5ya5GWlTsWU z_^2*cgnFCUC47O~rbetb|JsoMxkrn2Yu`MBO@?S=nPr2;=;IDk*WnSW3f&4q->tYc z5dYHmRdT2BzTss$?j?c5C3!r4XC$T5>0)1QiH2n5nyKXv=ywD4RB*Uda!kLX=}jR; zTBcI4h`%ujrm}sdY4wslPK`*&8=}NiVhaNz&n=AYP*967Q+ih;ZEb@S z8+6Onh{`NA}xcK9&GbiTWOn|(hEf28&&-CL0SK(YnrZ`U(Mr^lpip-azrrg{nXL3 z`mYw*bmyufq|bYqlH!ln&F`%twHfQ6&4_|vdK#$phB1=KOnb*XjSR**$B$cw6UIGy zWiH)`7CUitX*q%2l*K|45z+4dnYek8@yuirV<@Wy(;L1l)uc=K2JPuLqO_bo14PJ= zTO8D4zyud%NQ+5XPcyHnqsBI#nOWNZ_g|~bF0%#BWTcqh!n=5MCi9CMtjBUut3|MJc)ECJW48&y~~WUPoI|Az4Sj`;uB33%I1Y?@!lDX7B%8{%w8yt1JXXH&7rgam1Hrho72H4hVbVpZwh}vly6`|F}t;?rr%2 zX6w*H2ciw_<;5q$5h#!T^pGjKnjDIUUv3|`)H49n3M}Ez3A39pc;fEIlO^F zoSfK0(vx!eviC;NC_jvvGK+pbs^h(WRN$uMz&Y;=$93lvw4%2VkCMox8pqTQ+a{Fc z{GvBIlGCrgcbByi*6Oaxmce18Ml_9Z{C~QqV!2=(A65K$<_sG#>IUZK%bS-Hlrjat z7eDT3J$-N&v4TMM{}L!5qjqGHoAp!mF=okkIW~DHTKDC1Tf33BE6|664l=2 z4Xtrm@h-W&mWd*Jyy?M)f2BGbrAiGKC9?^tJ{`G;`|Y3Dvo_Gsu^d#iif!h)-NwMZ zn0n}{9G95ef;+7yJt;UUUq{d?zrji*q}2BbU-DW}#AdWV<&U#XPXyfTSkQ(7>9jH5#W=gkFj==H46J&$}zq*)YmJX zUl`$cew1`~k$f+qvALlmr!UG^r+f!Jpf>k=k`$d>={SKRe#dzP&FRIVExybtVnbW8 za{&Q#E*PQ1nA@E!lXs{s)jwE(lSV)jS`31Nam+{oznJ-*l{Yg%K-$AK1YMw04PxUg{Ax-KeelH8QhDNxcG_58QQ;<`oZT+{dnw{8zw0>{aCQ zZuNo8s<7cXt1rYS6V*?&ahW8IN3#^LvD?e6DStjvQM9kh&~5c2#!I=(-2zG4YQv05`dXHC<{Bn5=;?A$;2X7W)Ptaek!^WL zHxT|-79@Ka{a0oj?7cwue41u&SPvnsHFIWT&mx1mAqQb$A!{+%p>FMmh5 zsM$CrDz-cwqesa&qV_>}(`lOo%uhg)rmR(d$_R{8z`{4Y>?T@jNeQA3f+TnGkjP9*lH-5~_o$*oCtohcfW_t2|n7}8@>Z0M3 z4f>Na+!IZ$6e4K}TOVu(QUgSopRNbPCQyj147?`ZCZ=d$+}GSrw2gsN?}uhm;r0_kOuk(e)b*{DN+gJ@^MY%& zNdI39__!mlN^8CKi+`dGasL#jzk`n?03Rs*($llJ*tb8&!&y*&K^|o2;}8nJO1J8` z_`kCtD0EH|wPjhY*d5D3$#WFL(_m09K&(N|o+Ce|h zmZ_hQb&42yTc}g2RD$6bG-A6+TSaZohxe^_ zUo&bSlkuup_`cpHv;MPUYhU{$b6&l{Os5E&WLv%3?bh{NdiFe@>#Qv^z$bOT#kVF& z-lD{AmSCHOiglf`(x}9CQOh5rB@Bk#bSD>8!Whb9rrw_2vpXqXe*}zpmvXYLwZjxt&L(=qtv7kd{}!Jv%_p6cXmN%^r^edv zW!4<^bkU2fp*7;deA133s&b-VEVh2_sm<@WKWZ~DpbV|TbNsnq&dQx~%}N;=q483U zlLUJYwZkLwnwEnvB@>#jR^?CWcqo6}L}O0)SKwAE3g53TbX$GB-M{AaSByD-CFUrl zBAk7fXC=L~mbTb)0PPi6ZBkzH;T$=Cr+iV?WEv!odNBH&(n^AayN zcN54;-nM-o_5o$t#|E@-8#37%QTANf69X1e4JKr}g*>&Bq!Q;sLqH3UXE&z__?i(P z)M}=143?}3G^cHkyCHD+k%vvM2Q_FaF%j3#A%L(aziNnss>-^P9%z%D$wf1=6grvU zftym_L0>V~)_a4fe6EMuB5Smbr_pfQeq* zz0w}vLVjVfy^s95Z)xd0?>~vwQJ}5@*E17~jQF|O*pIEgh)EvTSK91mbTXn z`Acot43myFe>jBiK5Y!Q&St^`yjw6uo&iDKIzU>zo@@~ROu~5HeJADfCKYkK_z$C> z7`DRRu|;Np+QOv^!6u*j!v2CV;TIzl84(%`eZl_R2)KgW-{2cyP*E0v5t+3F{sB3$}& zoUiaMsUCG5er&jDW6C@V?`}qAJT#ti65^Ccw53OVgmn5SZh{NNn{%;A?Z)&x-Ww`} zt^FEYI^O=Nod3WNlwB>&7U>kU-t$TA_9UEs^;`+#|G@Vg!f`DG6!^X(qDb9qsDx>M z|7vAQ3p#Qk57Rdrcqr?5ilR`TjoL;;zL!8p0A+^kr# z|HdS+L^o4QnNv!Y6ckIi?Wkwq`?IX`^7~oCDNA;W^kA5mwI{f&nRu&V$%$HBKk2dV zIqP+dfi+&ZRZ#$5^KOP!QM}y`+VhB0P3FI*Te4T)R#mS(3UEs9jPH5p2Ttj7)Y7o8 zM*HL1g6YDQm8k~((mttDiVbo-1&pO)rr*`y%HrY_Cz_0*-V}LWBhH-NBl#P}fqIIh znn_T52(zfp=w58hwVI^r#_CvQBy`)H%9J5oNbF3dV8wz{R~}fjH|Ugka9X!J+6Yq> z6!tDK&i>R2Ur&D}F}OH8Pu}Blu_sr~Jm0*_ z-}boCp7s>&_wl=n!_2Qg~<9gF&&xD9n3;f03mba;W}JX?_Xd*>nW zNY2!dNi@1@-tYSZjMlO)^!b@YyTkyT($|ecWQ$Gq05OF3S*hU6)E_xu*m^rGeSnaf zUfVVVy3zkBG}}NF@H_THOOrlGiBT*dnz={1vS~Ui4EB{2OWxy@P$8FQIGn7s3t%&= z+ttpA;4M0|U>Txd2KFXoUjbyHUX)gHu{#K`UJdG_k zrxJd#G)A586YVmMcjzQuW^5@~QI=&6)@KG4_Zr+AQO>W_O293xfRC5>GvVhAbB`+I z7qb^uY^3K+(+Dupn{O^)ZdE@ioiwBQ$UbpGw?8MzH%hsK{6;}cC=%bD+EwCpNNrD{ z&-0P@8o_~+Q}5&Ds~7XFHZQcASYa0}>5IitSesu@7_2J1#V5Ps$xdoR z%VCM&@J%a;394H{Q&y(AR$f>Cn0prQnS5xHvS*6m(z!(aOLCvS>=E>*fKHnnF*qkL zy|-!B;rDVbs~1lPxjrgYB+h>SGr~o$OHsZ;!7oN!hF8{0&WiEj7^W`LHe#tHl3<$C zL!kr1p4x@t&8M^N*B_1Ox2^Hn3Opbr@@Fl~Y8V%6AN5 zFKvc9UN^bryl(x-@}Ai!hZ6^TnQ2yLB;9Yjh%)nak=~&_*pV$J-Y$_Vp2qSBgKqYc z$MngL8v60zl_{dUDub82l%jUQtGZ-<9+FQ2E@fmyS6+2)AF%@Wc}}sdd2mI56qMFi z;Zijr_roJQic4p`n|dIg9wD##RmqUzB_c&%XPJ$XIP#1{BMQu}s}hsysDDLgMJAe$ zmaTp-5Qy{_^$1|hO7P*z!TTK?UxJ63-WgvOtevvMf|+Oqs!&Lb12#8q2zaZOs$| zukTj)v$v-FAJSJH?Bc5TUF( zD&UHzvY{Y2ORNWhfz{;{bV)ykyJ=v(v}*n1G;t*;1;m{qqZ64MwePL%_3~f+`v(_& z(RzQH(rSuVZw0*)YT2zgvZSHdZHT38JC$o*XdPQqF}Kw7u}1t2aiEiQ!AkYJ;j{;X z7W^{q$aH7Hvg$d5=#lZub!|DAwJ=|s{mf6s z7NiCYJi9TttBG{YT^MaLNwuC?9hJ>mwbGj`X(O*4;USoOyX%XKyrZVZ+nBZ1Z2iX} zdV1HY#*^K4j1eHJf^gGP6e6|zN!lft z^pu+6Oe-@Prn>s6{a*Chk4cN?UD})>Io|g)kR&=nb{wSkC!8hCD7V+&oI0M`QrXfX zIZi92oldCbaaYER^x`L)Vn;`fjyu?cZc}6rt;=)Q3RBRb21Fp1Qk3dwS%XJ?>zZ!{ zwEiF|Buawoy>RYT$lE52c0zgIkg?Ng^$#(dbR(>G(obkZE`i$FaRE7hQEtd13pM+v zAVdD3vq6yx)y&%ytgz>JUJ6(2J9JJ$hwGb(;d>Pnp0c3~s#p|$gObUZS5tW{`3pQ8cqG@7x3 zFsj+a3A27Xfm(+Q0oJ%<_-fS1WwpHJh;=*pUG>mfL#fb~{#P>w6RqrJ(Ob0h8Kplz z@6t`gif6W*+exT-^*5l8>3jgBb$@pQUj2LRGwSzQ#a3ke*gklVd%UzKB@{jdfw9G) zLfMC4yuiq6o|H4XHl-22xJxlN4L^67qiOBgBPEI~@3mQdxloPGUj~cU`3;f?`|8KX zN|52Q@omTleHh=xrTZnA;qdVyg=jJ(y9F7X1kHZ1GXBrHl~Zp_D2F-~gkw8mfz-SI zQzyNt5x)ytf#omT5A%(FeK-)^P{3Y-`j}1h<)QxsPDrOX?7yv%5dG{Q_s|lND(X0d z4!bZ+boz%~)DGSQi>-fCr%=B|;aMCrbV2}m)NjP30u)tcu%$K>RVeh0HH{NmNl*_R zyy6aI5zAvTUTWv;4>Zz%=iN^VN`lVP(qnxoH9qS=FHlZ54}c5t#na*4v5ZNh*{A|v z1Fz@AZ8~WET}j;q0cky}fvu8@UX7hry91h7y1s2!R8$m{BF#b(=~AV86;UY>QCbA9^cEsWuPPT6Ly;mKq9O#u zfT1Mxs0c_eA)$mMUP4a*LkW+6#q6={b2~?#L`U4B1D#NJjRG`)| zHU~&o*4oQ{lNCi74Kj8~9#BNyqXz)iqdS+eM%mw96|st1m9}+n*EzW)uwhTdFJ=J} zg80`7B8Rhdv+tL!))yth;yI+7% zxS6eld{Y2lZ_>Gk!58&da!_EUC*&p+kd&TVIq#C303So!&7bon$r8I9OfzT3Anim8 ze7b(~MCZU-XmGGrr`S{=scTeWND=fnZnJ;3daLkyA>5=T_CY>{YH+ejVp{iBrU-0{ ze%<5QvFqnwZKuvBP;vsytWN^S=PGKS?AX#L0>S$`XAgB|9qnANI_-o75Dq7Flok_% zc29JQ+Kot!7Al$=`JgxlIH85_qubdM7XS=cj@bL1ZsVXyS@l=)^_Vc zf!Ql*oxd_9cHRDYq|(YckuC6Y?%^A6ud0`Aj9`^z(SKGYF^_hB`u5XGD37<>0r^N; z{uj0J>WB>`y9yH&9e%mfZ#%&Rj)hUV^9MA7!N>r^I+&;sgN6IPcDF5Xx_;7l9s$0R z3RU@M25X<)-Hxf8?OZFN{8}BgeZ2k7tG>V@P_tL$8VxtQ9fB}*cGchD=$WZksm{vd zRz+3>7DZAYmtU-?qRI`m=ERxxDMHB_bzDJCq@&DgqT{r*Y>K$4vETZ}yvZ{+*u!nI zq=eTiraWwBzx7bnMR?Ubrpf*jT&~--NRDc7bRyOwMq+U-v^?C25}8S*#pRhNwZ>${ zviT^}TYYCzTuyLy=+!SPi}ZE@AZ_vQ($a1-3FrHTt%LovjMLF^w$#vNXLiBe%`n%Z zi?3j-*l5*Ffku}8gXPE^x)&~G3fn%`Q?iU%&4S-?Z^~VsJ0Gv7a`;k6oLFeEHSmGuVckhB+H_Oj&C^b~ zV+`#s@altD&HZ!0*1y%fXX(rjyus>3)kf|14%hJlH`LyvcBM|3YCOOOd5*+Qg{cEm z`5D0CD8@@9Ir*1_3s_S1peV@jxb9x++dIV(z%2hO^%Gkx^W*Sp$fcFAjt~zt=8i(u zUIZtRQlmWTQpR&0|Lvewrpt2};^nUYzd_aqTHh@JM4sHfD#G&`hnR4n`Y7F<;bK4RR#GN-X zDeSA~9f1|5%(GtgJTI*x&k2o(qH$smpnO1D_4Mz5a9s!hi#b~R99WYChs4rZg}%@|XqkW@ z_TQLHfH`FS=LUefejw%s&uHAr8?h%cBk()B3k$kGwqjsb!SylUkrv;+E;Ks@H|s>) zrorm)|TGLv4X0o*k)ty2D~s?WeZIR-41-Pdme z>n3{e2~Pyw#|LP$E~i}vlosGJz|;ThpFMyJSi>f4zKvvXX8C+Q=B!VCnmzn&=jva4rhsg*V%>am|A7fZK)SR0*?i{8JgaGaMnhJ1 z-^`J9o}s;J@Dgz4COo9^v#+axN4n^}cps?XZB`OCaZeJJ5Pcv=#71DvV2tNV7~Z|m z{15;KpUVh%h#pG_2bP=EgwhIzmW zz%q~Fy_gbeXU*tI#%Dx9;{toF(W;a#;PL;lgXXpEDV#!l&9lGfIJ9`i?u4Uvl;1%Sdzy$v3 zyNZzhB>{Mp%#RuNU(?qpnmws~waGc@cr);)UniYt%OPpC>;rbh{XV>rLId#E3esU*+%vlCwVHHR7Gk?(4{U`&*9zNl zcm8|u-|Am!o-M#ZC~zj&;Mj)k5^oDM{ojMapmx2|Ly_& z+!>k{)!}E98Vmh_Jv7iUfKCR`u`XMV;|JsM^D!_luUDpdHcG<vy=nJyDg3uM0KX1SEv9rn+6NqTdz% zzzda%tQpHDIMC^fr4G%dK+#4xtn2qpjbp}g36>g^3cLf|oz@#x9U`ocYg_=XxY0BZ zr(C2BL42Zge!j!Q^G01 z*;UmK1+Kts^?t-`-6_Y6fk(k~Pnt3_Y(rSTC=zC95>vR%?U@q4)zYp5)LX(^+MS!p z|JKt1Ml!-KuK~g=fG~$w1sL4~_@<43qa*)QE|g=oZrp`3lD{vG|7Y*RzZ4L*E$#nX zIPPl$!4)E@zYpoW0jOQtuu+oAYS+mD_SH6o;aNbP`$`!8-gf0M3^c?l7mhQ9K@9+& z;fu;f$u#9w2Eg<7D5$QRGWCxmFuc5mgL^lGi@4g(mmz! zcN6;Zi(I*5h#X_4!fa~Ht8F*L(6Q_ym+fBzI zKsmqCjQdr%7f>uvlbaKyrMPMCun>3p2WI9SRLO_d5A|T?*;KPIs z4{5K^`^_~q#@L#nH%=%5*IjAl-K_1g+S+pQ!q=G6Dum8ZF{B)-IV46SXyXMTOD{ck zzcpU(B!r-4!RZiAj6OBOa`gsP`WwToBC>HxxvOXvC1TaL6+$g?TSC=!rZcj_%|Twy zW=p8nDMk1h-HEJ=F-R@@5Udzy6RysN`;ko@~ZCl@ayRv7t z6p>Hq8ssdA`JUF2K1z;Lahx?y=dlQO$I|)Hc=jXa>A}&A`Q$kWzA&bc8SF{1jR1uO zSTgY>qDSlP&0fhWFg}~UqTQv23D{vfMs4kvFhcbW>7rchB7SZm$(tuu|_r=H(uM4X9!WVX%a zR0@9AG84uO#w^Y2I85fhoLfAAT37A^`dh_Q;ALP9zW zygJfj#{XUov(zB!HMu3$GoU&(%Hw2hwaQkOYk?RglLQtuF7~UfD=d~CEbPE`_0q*l zst~f;v6x@CIC?c<%2j7}*JB+qa_meGaryx0GCOt|CYG@?Ha5X+4JQi?;qV43O{u=H zDB@}!sKZh3;HM6S=FsS2_!%%x@3kgVWPWVx}HkmFx&I57%Q`hi>ut}tdydDg8vZ|&dUQn*-z&S0fnK}8rK4(Fodnm zrIj8dB1gZYZo3?HfB()&gXPpJZmy@LL5wGoiFb_A@6A(((iIW5A^quM8xvtSH@*(M zsuK&xIj*HL3)Q4l9>CE)-&`k0$E}!#dn59vU zu5G}SPzEPK5ymC0Y zQWHm}V{)F-rPSGp0nyoguVnLU;-A=(h%D7)#SIs2BSUnfRuQI2I_kxSxO2yZel@ZV zDGMFZgi(S#r9Tu`RI}^dn>%x^f|=?b6cDTMZ>H^V>#rma#6}jURQE(G6edqx6I^&X z*IJkqg|;Ht%GR`z>5p2JHv@BHPC(K+aEKcd8HSw0RGKEcqbDZFqf?`SL7kU6ce&1r zcwuM8zWpf~y)SpxHdWf&H?BE_u9LQ0za1V%mk-fC>yBNe zxr77nE{-U!LmZOf6P&tvmD%LUt^8n|7ITw0g^Y-YJ8-&oHtU&pSZe~JK5*RraVTH$ z1?7#$j)uOQqf|xr%_wC^!xbNT&#==C`ViylJ?$-%a)Cl0iAhdn4&ZlTj&hVR9rp z?5rzue(w?7HOU%cB(X7cRua~uvb-`mQcQf48iGP1bXL^b=;8kBCfCSjKj`6L_$@YL znVAv`U=`Iwp=(o8ZYF~s49s7wGGu3N&c(Il8FGJgn$;z^74P3jFl@p$m~DO|tgb*) zlXpE!3`6##Y}Yn_6l68{9X!}kXndLcyBnFOOs3}Hfp;D#WyviKQy@Jii z>akuApuK(5FW;~%-L0VJo%7jA^gAc2e7W}l)JEUgpdTL0A{z7xx!^ct8Lv&q-fP`_zvxadeTXPU*`=5Gxck9rFxQJAR z@vPmnvXD11WU!t^Yhr5Uk7b7qX%#ocsA|gf>J=nCW2_KcjV&1n_jic$+1TtbOJxP; zOVbA`0qZMV$FE}n=jZ2#u*m(y*;n3rbxzqo&q%piVVpoj84@G!>gd{0h-2QpC6wfX>(^jYK;&)S~b}ry<6?ivh$>1Von}LN$^q6jUA8C+LYLRn=>gN zXOc~3Jur!#9bO2-s6vi%$GJRKWx;5MCOfAfoBbq-CNLc1h`G$(TNd>+2`M?>yL`y4 z@NkWb&Fn^)HYNm`*x9)DTx87+;>3Cp`V3vFL1;+W)c3?Xx{r2R@}(CmMg}*%&O>P# zdKwq@LVJvSIW`+2ZWVfKH}c#xDXdC9~0WB!CAwd35cXUoTH`m3+O=+eZ`{Ors?uqf|Gr^tqgW1o2_27g}-qrpWn zk!RUnXTWQzjaqKvMJmEF?EH)fzVF`~>H5vYotLGy=XPZ)(L@{(zB@9<{chWkTB%7= zpC%+3>s4*Mkz79`fJ{dEVRk}mblIWWlH1Bsh85r3U!*%#8iy8h3|Te$4ff>C32G-& zJ7vx2Ba+q~SI7`>0`OaEvkp407B!@%f)PA&B{V4ha(#xF59~;_Z zPY#dT$u-`thy+)=e6Lo8?FgHtp7g|;C5bDRL04oM_BCC67NLPqco#foU8FmFvp(jB zdFIQNhsxFaZ1vYqHJVn`*1yM zimnFP$@o||L7DVhRZ?<#prbWBEanH%Xx_?JDY_fAm|l{cvFm_wT=MrZH&-I&wL?YB z!O6xaD^jC;%$RkbJ)-<48Mct({w?jb3pdS$7_D3sMS4VMeAxXlIVHm9GPLt;NdY}2 zH6_0(WapbsEH0dDALhR?YabM>8Nk(mTw}IX%dhNYO&*raLI@^TYQ;#I+4;W; z%S-XTF*;Kyx|L0}V{WE!Pxi(>7k45N31os7_m~o<5nBZcqkB%GiBseEg{!)r+q=Xe zw)q>*5h$)GIW~T1M+o^fJacC&Q1Mf%j81JxUQyA6nqC<`WX+B`>c0Ck;&kncH!&)X z%0)lsY&>FpPcex^-i8 za44fsVUvI5nHcN>th3T{YsCH-4ZcTQFCEgccD{pfY+a0Rc4AEmsx7&o`JLEwWA_S| z&tNGrSzg{W$Zea6Zk}DAd!MY8O-c|gf-WU4B!zfkwZ&Y-0Qo#XoTIFrHJ{87$aJ&& z;%GNiDTf!Fr-K|hf0JHwj@Ig)Y2eg21$MLb znq70`-1;d$PncQR386)~79)&kTw&IRa>NCZHr5c_#3J?ZDvJ=i_EfEkGM9y>yLtHA#e!~XFDiDDIE)Y)FI zLh_|!eR|nKG(rydM7!TndAsQ7oo-8r+lmp%))wB{@P=ABww)Q<5DTyDxwE;7Lyl*W z5VK4A-}A_=%_|Yfj4WkHOiW8e)k#P~S6F_>Ru(!Sqp%!Z0D6$GWjIWxc(K^_ZlK4H zxyu)uG>up-I_&Zf>~9}si8%Zuj*=aB#>@=_1+Udpo1~>N21T6eJe>!<$j`cYIbclr zwdwb2y_B0)bYfJQb57Z%TvDDK+{kT8hKflm-A3pr4a@!9;)nQf#tdFfd}|l- z^7cw9ria4LlM*}r zGHmYH)BGEo`-}Rd`b^ED zvCTwOT?42ECG^JF2rZZ2R)4Y}%Pg*E-cF0u0CS`1>9n(Z1&(Wrr5bsQL!?`pb+se? zU7`far;3TP?u3bn-gp&Rd z^>LDtwB(Y^+QHoM_F}}_90@fia@I>)l>zHRK=MMw!5*`)r=?AZAuSdT%k|yK8yaoG z%ie7`(lJ0urP=05ICdjNIep;W7x$|UIT*3{2gjg&rTRxI-I&U`qw6W`b=KIHRz&A; zcBfhD!t{!DcB->8-be4qgQA$n(?)GcaX;MS!0(k;F1O8$V;le3#yNI#N#I^RX{P|j z1dY;QvspcAdsNi6EH$dVS4;@u)2UWl(r7cbVNSEmw$cu+zf1^-H3{$tm8oRksN_Oy z(aBPTCG806Ckex1lq}mzJkFXu=GjGW^4)RyQ}P~C0*f1*c$K;wtK9GKKn#TLR0jPq zP&os0?+aa4tf4T?;uI3+u;*==wU}Hd>gP+F*DSek_xm8?{MO_zUAwuMYqszq{Qg2# z&5M!j$-E)A7o-S^JYjvh^5lb&ni7!C@*Pl$z0UH!)MIH|^Qm_@9H&w{;-`FERm)+W z>v5*rbS)VMsPs+PQFrXvDy6<>=a%^HjQh0@ zh6JoK@cE31R5@DL6EDmlKrPpZLn-l;6#bS_B-8Ie+;F- zmMkCT$Qs3T4+Iqfa|BcG59 zv8RV+;|;Z}Rx}pHSp6Sbt(DwMoqnw-&@Iev*xmcf=e;PEb;SOr%_8PR#n`!E@$7~B z{?j1QTvhdz_J>bgh)###N8@K7%D5kNtkYe%tEa*ra5v-0_m4i7X@ZWs%WKj1U!MxR zNoAG7Q`-mH`G(eGOv^n4PgE3by_xlRvXi57@0#VnwQHiG&hsB04qi_nMdU3yZB(7R z{{8h>{Em21x^wnM*6D;>ISNNdZ@(YbGZ*@prdnX{^;etNi7W&Y+QPSau-D|qtWV>58QS}sL4SEuk-53%dUO%0li80t&?LQQ_)$L#Z4g`Wz9N6OHs z(uIHQAv#GT{0D3GCsd!bbV&9RsE4dtU(jDEWT`unYH%8~z&i{H0sYPZxet2r0Sz7NuwRHB&-Vn{f2#gHLZV zpC}Q&<+(Dv6&`z?fUlh2`%*U;1wW2_@w8OaBGz}Y6?K;S40C(+pU~kyhV33}T(n2- zG2BEOh%bgVg%F&o9B6!RZzx<2y;8n;XuT=Cz^d)n=e;8LPKR0BVl0BxO2vDvq)Z&0 zL@bXn>Jo!WTe;e3GHp0G%4W*$&}gF4NiBQhc4xb<(22Px#bDI9fohoT7i! z>OzK7%g5TbpR0^v!R2Sth_(K!Z|}SRB~aA4$;hJguW9C=&h;*T_z-2JP-Z45^LD07 z)5Az6Oce}*I`KO_#b+7@9dEhxEi%Y1z+UHt|3}Fy>X8p0)j|*FepBvtK6Q}qol(eh zLYWA~%7g6QHFwsD{4Dx(>PX_HE5uU{ii)d=cWzj`)A8Sb5d1(jNdM2r*fNIWo>7=A z$9LbAlkp~^Lfx-#uE$JO3jTcg=0^e+V{?r33-l50Vse-|VxE2e{#>v@6(w!xp0=;? zXG|WfIT3v=zQR5TH&1@B+k$F2@`6SyQy6YrdF9`WJ0Mlku$6xOMo6nnfXAhW^5a|2 zXHCc7JR{XHg5HGWyju~XC!|Z=aHtp+zi}+!m{ao+8t8A8$QwF>wv<~hAeC{7!m{PML%L}hWG%%GV zl6KVV0ruBH-_2?B(6rayZ;ifaXWa;>J-(jBY5;rH7zXxao~`z{eRf0cI0qqhSU9y_ zRx3M!Z1{LwIrFM?vp20J*83^nKR$#0e+&rhgR^G7O*91JzF9t+bA9yQ?T^16i#i{| zpS}%$x)YhH>w2NQY{iuk3MMD*p7vuiuLrzjqr5PJ2tdRsK`g z<7j#$iylxn^UPXEWj?a<`Qr@FS|&sB)VaN#o+E?T_ltH4N*-H0=oq_=xhDUU&no?* zgr>M7{nWLItD`TkUR6CG8R7oyp4xj1Wk~+7$0eZJs&qw&bg?Yo{f*Th33DmSCw`ZP#L)a{ehK4j)_QoTqv2-e6wa5bT@B3aSx z?9bQt(&lMCmm_H_onJuJua!?YY|1(%6qsha`kvCT()jzGS$N2)gs(G-B>d;XS2e@c zg>N^bv~+2jXB-0rn5+2p0KKT3<)ZHyn&8p8#?$;(xdS@qqn=^^;Oj#ixuB|F7HZY> zaO%U0g|C)&-})mi4EJJTk}iM5W>ms;YR_Ku-=HxaybqUudl*3)hid0F!5s3gRCw-u z?{6inet!~sYD?jS(-&#STp?S;OE=1Jjpo&r{@2FW?RETP&WGJudHnN6(#FcK0QsMh zGQ%9ztOov1GL(XSZ}CdT&o?74ecjHopg64;I~DGV_hW8lY3?u7+Lv`7Me+DqVL;E>S@8D_M5&$S#EQ0kkVW z^JufE86^r1dFdqzGb{gTPNen!J}c?+Zw@PR|6#N)-8P(g@GGzFHyL1KrC7rwqSul6 zA0odg{qH9Ge^31{?+2bfw`tm0r82Mox9!jm9#J0((D{7(-`t)8X9>U*dxtYKPyfZc zO3jN|rJoXhbF0>zkpuesUoOj*S)~@hxP7zdT?NUjMzdu9?}54Q{hQPu9zM4t3QH7Z zpOh$Q6_qGRs+rpi1Jn-ul~wv330$h+Z|>W1w{2o&_$Sjort5=7QsGHdKv|Xa!eMGB YNF!CgE9LI{9f51t(cVuEo!j&O00R3;i~s-t literal 0 HcmV?d00001 diff --git a/man/Comparator-class.Rd b/man/Comparator-class.Rd new file mode 100644 index 0000000..851382c --- /dev/null +++ b/man/Comparator-class.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class-Comparator.R +\docType{class} +\name{Comparator-class} +\alias{Comparator-class} +\alias{Comparator} +\title{Comparator} +\description{ +A class for representing a variable that will be used to compare samples between two groups. The variable's +values will be used to split samples into groups. +} +\section{Slots}{ + +\describe{ +\item{\code{variable}}{A VariableMetadata} + +\item{\code{groupA}}{BinList} + +\item{\code{groupB}}{BinList} +}} + diff --git a/man/CountDataCollection-class.Rd b/man/CountDataCollection-class.Rd new file mode 100644 index 0000000..f18d5aa --- /dev/null +++ b/man/CountDataCollection-class.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/class-CountDataCollection.R +\docType{class} +\name{CountDataCollection-class} +\alias{CountDataCollection-class} +\alias{CountDataCollection} +\title{Count Data} +\description{ +A class for working with count data, including microbial or genetic assays. +} +\section{Slots}{ + +\describe{ +\item{\code{data}}{A data.frame of integer abundance counts with genes (species, etc.) as columns and samples as rows} + +\item{\code{sampleMetadata}}{A data.frame of metadata about the samples with samples as rows and metadata variables as columns} + +\item{\code{recordIdColumn}}{The name of the column containing IDs for the samples. All other columns will be treated as abundance values.} + +\item{\code{ancestorIdColumns}}{A character vector of column names representing parent entities of the recordIdColumn.} + +\item{\code{imputeZero}}{A logical indicating whether NA/ null values should be replaced with zeros.} +}} + diff --git a/man/differentialAbundance.Rd b/man/differentialAbundance.Rd new file mode 100644 index 0000000..17f009d --- /dev/null +++ b/man/differentialAbundance.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/method-differentialExpression.R +\name{differentialAbundance} +\alias{differentialAbundance} +\title{Differential abundance} +\usage{ +differentialAbundance( + data, + comparator, + method = c("DESeq", "Maaslin"), + pValueFloor = P_VALUE_FLOOR, + verbose = c(TRUE, FALSE) +) +} +\arguments{ +\item{data}{AbsoluteAbundanceData object} + +\item{comparator}{Comparator object specifying the variable and values or bins to be used in dividing samples into groups.} + +\item{method}{string defining the the differential abundance method. Accepted values are 'DESeq2' and 'Maaslin2'.} + +\item{pValueFloor}{numeric value that indicates the smallest p value that should be returned. +The corresponding adjusted p value floor will also be updated based on this value, and will be set to the maximum adjusted p value of all floored p values. +The default value uses the P_VALUE_FLOOR=1e-200 constant defined in this package.} + +\item{verbose}{boolean indicating if timed logging is desired} +} +\value{ +ComputeResult object +} +\description{ +This function returns the fold change and associated p value for a differential abundance analysis comparing samples in two groups. +} diff --git a/tests/testthat/test-class-CountDataCollection.R b/tests/testthat/test-class-CountDataCollection.R new file mode 100644 index 0000000..3268076 --- /dev/null +++ b/tests/testthat/test-class-CountDataCollection.R @@ -0,0 +1,30 @@ +test_that('CountDataCollection validation works', { + + # Most tests are handled by the parent class. + + df <- testCountData # A count dataset derived from mbio + + testing <- veupathUtils::CountDataCollection( + data = df, + recordIdColumn = c('entity.SampleID'), + name='testCountData' + ) + + expect_true(inherits(testing, 'CollectionWithMetadata')) + expect_true(inherits(testing, 'CountDataCollection')) + expect_equal(sort(slotNames(testing)), c('ancestorIdColumns', 'data', 'imputeZero', 'name', 'recordIdColumn', 'removeEmptyRecords', 'sampleMetadata')) + expect_equal(nrow(testing@data), 288) + expect_equal(ncol(testing@data), 909) + expect_equal(testing@recordIdColumn, 'entity.SampleID') + expect_equal(testing@ancestorIdColumns, character(0)) + expect_true(testing@imputeZero) + + # Expect error when input data is not integers (not rounded) + df_error <- data.table::copy(df) + df_error$entity.notAnInteger <- df_error$entity.A2 + 0.01 + expect_error(veupathUtils::CountDataCollection( + data = df_error, + recordIdColumn = c('entity.SampleID'), + name='testCountData' + )) +}) \ No newline at end of file From ac76e88d2461d3ff9e79e8d97712ce2002a60179 Mon Sep 17 00:00:00 2001 From: asizemore Date: Fri, 25 Oct 2024 18:33:43 -0400 Subject: [PATCH 3/4] successful differentialExpression call --- DESCRIPTION | 1 + NAMESPACE | 12 +- R/method-differentialExpression.R | 149 ++++++------------ R/methods-Comparator.R | 23 +++ ...Abundance.Rd => differentialExpression.Rd} | 16 +- man/getGroupLabels.Rd | 19 +++ .../testthat/test-class-CountDataCollection.R | 3 + .../test-method-differentialExpression.R | 140 ++++------------ 8 files changed, 134 insertions(+), 229 deletions(-) create mode 100644 R/methods-Comparator.R rename man/{differentialAbundance.Rd => differentialExpression.Rd} (77%) create mode 100644 man/getGroupLabels.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 45d1639..c44e4b8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -57,6 +57,7 @@ Collate: 'methods-Bin.R' 'methods-CollectionWithMetadata.R' 'methods-Collections.R' + 'methods-Comparator.R' 'methods-VariableMetadata.R' 'methods-ComputeResult.R' 'methods-Megastudy.R' diff --git a/NAMESPACE b/NAMESPACE index 3aac58e..5708f1d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -19,7 +19,7 @@ export(CorrelationResult) export(CountDataCollection) export(DataShape) export(DataType) -export(DifferentialAbundanceResult) +export(DifferentialExpressionResult) export(Megastudy) export(PlotReference) export(Range) @@ -43,7 +43,7 @@ export(cut_interval) export(cut_number) export(cut_width) export(data_frame) -export(differentialAbundance) +export(differentialExpression) export(findAllColNames) export(findAncestorIdColumns) export(findColNamesByPredicate) @@ -77,6 +77,7 @@ export(getDataFromSource) export(getDataTable) export(getDiscretizedBins) export(getEntityId) +export(getGroupLabels) export(getHasStudyDependentVocabulary) export(getIdColumns) export(getMetadataVariableNames) @@ -128,7 +129,7 @@ exportClasses(CorrelationResult) exportClasses(CountDataCollection) exportClasses(DataShape) exportClasses(DataType) -exportClasses(DifferentialAbundanceResult) +exportClasses(DifferentialExpressionResult) exportClasses(Megastudy) exportClasses(PlotReference) exportClasses(Range) @@ -143,7 +144,7 @@ exportClasses(VariableMetadataList) exportClasses(VariableSpec) exportClasses(VariableSpecList) exportMethods(as.numeric) -exportMethods(differentialAbundance) +exportMethods(differentialExpression) exportMethods(findAllColNames) exportMethods(findColNamesByPredicate) exportMethods(findColNamesFromPlotRef) @@ -163,6 +164,7 @@ exportMethods(getColName) exportMethods(getDTWithImputedZeroes) exportMethods(getDataTable) exportMethods(getEntityId) +exportMethods(getGroupLabels) exportMethods(getHasStudyDependentVocabulary) exportMethods(getStudyIdColumnName) exportMethods(getVariableSpec) @@ -178,7 +180,6 @@ exportMethods(writeStatistics) import(DESeq2) import(data.table) importFrom(Hmisc,rcorr) -importFrom(Maaslin2,Maaslin2) importFrom(S4Vectors,SimpleList) importFrom(SpiecEasi,pval.sparccboot) importFrom(SpiecEasi,sparcc) @@ -190,4 +191,3 @@ importFrom(purrr,map) importFrom(purrr,map_lgl) importFrom(purrr,none) importFrom(stringi,stri_detect_regex) -useDynLib(microbiomeComputations) diff --git a/R/method-differentialExpression.R b/R/method-differentialExpression.R index 4fb0555..6ff806d 100644 --- a/R/method-differentialExpression.R +++ b/R/method-differentialExpression.R @@ -1,15 +1,15 @@ # a helper, to reuse and separate some logic -cleanComparatorVariable <- function(data, comparator, verbose = c(TRUE, FALSE)) { - if (!inherits(data, 'AbundanceData')) stop("data must be of the AbundanceData class.") +cleanComparatorVariable <- function(collection, comparator, verbose = c(TRUE, FALSE)) { + if (!inherits(collection, 'CountDataCollection')) stop("collection must be of the CountDataCollection class.") if (!inherits(comparator, 'Comparator')) stop("comparator must be of the Comparator class.") comparatorColName <- veupathUtils::getColName(comparator@variable@variableSpec) - data <- removeIncompleteSamples(data, comparatorColName, verbose) - abundances <- getAbundances(data, verbose = verbose) - sampleMetadata <- getSampleMetadata(data) - recordIdColumn <- data@recordIdColumn + cleanCollection <- removeIncompleteRecords(collection, comparatorColName, verbose) + data <- getCollectionData(cleanCollection, verbose = verbose) + sampleMetadata <- getSampleMetadata(cleanCollection) + recordIdColumn <- cleanCollection@recordIdColumn - veupathUtils::logWithTime(paste("Received abundance table with", nrow(abundances), "samples and", (ncol(abundances)-1), "taxa."), verbose) + veupathUtils::logWithTime(paste("Received abundance table with", nrow(data), "samples and", (ncol(data)-1), "taxa."), verbose) # Subset to only include samples with metadata defined in groupA and groupB if (identical(comparator@variable@dataShape@value, "CONTINUOUS")) { @@ -71,20 +71,20 @@ cleanComparatorVariable <- function(data, comparator, verbose = c(TRUE, FALSE)) veupathUtils::logWithTime(paste0("Found ",length(keepSamples)," samples with a value for ", comparatorColName, " in either groupA or groupB. The calculation will continue with only these samples."), verbose) # Subset the abundance data based on the kept samples - abundances <- abundances[get(recordIdColumn) %in% keepSamples, ] + data <- data[get(recordIdColumn) %in% keepSamples, ] - data@data <- abundances - data@sampleMetadata <- SampleMetadata( + cleanCollection@data <- data + cleanCollection@sampleMetadata <- SampleMetadata( data = sampleMetadata, - recordIdColumn = data@sampleMetadata@recordIdColumn + recordIdColumn = cleanCollection@sampleMetadata@recordIdColumn ) - validObject(data) + validObject(cleanCollection) - return(data) + return(cleanCollection) } #' @export -DifferentialAbundanceResult <- setClass("DifferentialAbundanceResult", representation( +DifferentialExpressionResult <- setClass("DifferentialExpressionResult", representation( effectSizeLabel = 'character', statistics = 'data.frame', pValueFloor = 'numeric', @@ -99,29 +99,28 @@ DifferentialAbundanceResult <- setClass("DifferentialAbundanceResult", represent setGeneric("deseq", - function(data, comparator, verbose = c(TRUE, FALSE)) standardGeneric("deseq"), - signature = c("data", "comparator") + function(collection, comparator, verbose = c(TRUE, FALSE)) standardGeneric("deseq"), + signature = c("collection", "comparator") ) -setMethod("deseq", signature("AbsoluteAbundanceData", "Comparator"), function(data, comparator, verbose = c(TRUE, FALSE)) { - recordIdColumn <- data@recordIdColumn - ancestorIdColumns <- data@ancestorIdColumns +setMethod("deseq", signature("CountDataCollection", "Comparator"), function(collection, comparator, verbose = c(TRUE, FALSE)) { + recordIdColumn <- collection@recordIdColumn + ancestorIdColumns <- collection@ancestorIdColumns allIdColumns <- c(recordIdColumn, ancestorIdColumns) - sampleMetadata <- getSampleMetadata(data) + sampleMetadata <- getSampleMetadata(collection) comparatorColName <- veupathUtils::getColName(comparator@variable@variableSpec) # First, remove id columns and any columns that are all 0s. - cleanedData <- purrr::discard(data@data[, -..allIdColumns], function(col) {identical(union(unique(col), c(0, NA)), c(0, NA))}) + cleanedData <- purrr::discard(collection@data[, -..allIdColumns], function(col) {identical(union(unique(col), c(0, NA)), c(0, NA))}) # Next, transpose abundance data to get a counts matrix with taxa as rows and samples as columns counts <- data.table::transpose(cleanedData) rownames(counts) <- names(cleanedData) - colnames(counts) <- data@data[[recordIdColumn]] + colnames(counts) <- collection@data[[recordIdColumn]] # Then, format metadata. Recall samples are rows and variables are columns rownames(sampleMetadata) <- sampleMetadata[[recordIdColumn]] - # Finally, check to ensure samples are in the same order in counts and metadata. Both DESeq - # and ANCOMBC expect the order to match, and will not perform this check. + # Finally, check to ensure samples are in the same order in counts and metadata. DESeq expects this but will not perform the check. if (!identical(rownames(sampleMetadata), colnames(counts))){ # Reorder sampleMetadata to match counts veupathUtils::logWithTime("Sample order differs between data and metadata. Reordering data based on the metadata sample order.", verbose) @@ -158,64 +157,20 @@ setMethod("deseq", signature("AbsoluteAbundanceData", "Comparator"), function(da adjustedPValue = deseq_results$padj, pointID = rownames(counts)) - result <- DifferentialAbundanceResult('effectSizeLabel' = 'log2(Fold Change)', 'statistics' = statistics) + result <- DifferentialExpressionResult('effectSizeLabel' = 'log2(Fold Change)', 'statistics' = statistics) return(result) }) -setMethod("deseq", signature("AbundanceData", "Comparator"), function(data, comparator, verbose = c(TRUE, FALSE)) { - stop("Please use the AbsoluteAbundanceData class with DESeq2.") +setMethod("deseq", signature("CollectionWithMetadata", "Comparator"), function(collection, comparator, verbose = c(TRUE, FALSE)) { + stop("Please use the CountDataCollection class with DESeq2.") }) -setGeneric("maaslin", - function(data, comparator, verbose = c(TRUE, FALSE)) standardGeneric("maaslin"), - signature = c("data", "comparator") -) - -# this leaves room for us to grow into dedicated params (normalization and analysis method etc) for counts if desired -setMethod("maaslin", signature("AbundanceData", "Comparator"), function(data, comparator, verbose = c(TRUE, FALSE)) { - recordIdColumn <- data@recordIdColumn - ancestorIdColumns <- data@ancestorIdColumns - allIdColumns <- c(recordIdColumn, ancestorIdColumns) - sampleMetadata <- getSampleMetadata(data) - comparatorColName <- veupathUtils::getColName(comparator@variable@variableSpec) - abundances <- data@data - - # First, remove id columns and any columns that are all 0s. - cleanedData <- purrr::discard(abundances[, -..allIdColumns], function(col) {identical(union(unique(col), c(0, NA)), c(0, NA))}) - rownames(cleanedData) <- abundances[[recordIdColumn]] - rownames(sampleMetadata) <- sampleMetadata[[recordIdColumn]] - - maaslinOutput <- Maaslin2::Maaslin2( - input_data = cleanedData, - input_metadata = sampleMetadata, - output = tempfile("maaslin"), - #min_prevalence = 0, - fixed_effects = c(comparatorColName), - analysis_method = "LM", # default LM - normalization = "TSS", # default TSS - transform = "LOG", # default LOG - plot_heatmap = F, - plot_scatter = F) - - # NOTE!!!! Coefficient in place of Log2FC only makes sense for LM - # see https://forum.biobakery.org/t/trying-to-understand-coef-column-and-how-to-convert-it-to-fold-change/3136/8 - - statistics <- data.frame(effectSize = maaslinOutput$results$coef, - pValue = maaslinOutput$results$pval, - adjustedPValue = maaslinOutput$results$qval, - pointID = maaslinOutput$results$feature) - - result <- DifferentialAbundanceResult('effectSizeLabel' = 'Model Coefficient (Effect Size)', 'statistics' = statistics) - - return(result) -}) - -#' Differential abundance +#' Differential expression #' -#' This function returns the fold change and associated p value for a differential abundance analysis comparing samples in two groups. +#' This function returns the fold change and associated p value for a differential expression analysis comparing samples in two groups. #' -#' @param data AbsoluteAbundanceData object +#' @param collection CollectionWithMetadata object #' @param comparator Comparator object specifying the variable and values or bins to be used in dividing samples into groups. #' @param method string defining the the differential abundance method. Accepted values are 'DESeq2' and 'Maaslin2'. #' @param pValueFloor numeric value that indicates the smallest p value that should be returned. @@ -223,25 +178,22 @@ setMethod("maaslin", signature("AbundanceData", "Comparator"), function(data, co #' The default value uses the P_VALUE_FLOOR=1e-200 constant defined in this package. #' @param verbose boolean indicating if timed logging is desired #' @return ComputeResult object -#' @import veupathUtils #' @import data.table #' @import DESeq2 -#' @importFrom Maaslin2 Maaslin2 #' @importFrom purrr none #' @importFrom purrr discard -#' @useDynLib microbiomeComputations #' @export -setGeneric("differentialAbundance", - function(data, comparator, method = c('DESeq', 'Maaslin'), pValueFloor = P_VALUE_FLOOR, verbose = c(TRUE, FALSE)) standardGeneric("differentialAbundance"), - signature = c("data", "comparator") +setGeneric("differentialExpression", + function(collection, comparator, method = c('DESeq'), pValueFloor = P_VALUE_FLOOR, verbose = c(TRUE, FALSE)) standardGeneric("differentialExpression"), + signature = c("collection", "comparator") ) -# this is consistent regardless of rel vs abs abund. the statistical methods will differ depending on that. +# This main function stays consistent regardless of the type of data we give to it. For example, in case we add non-counts data in the future. #'@export -setMethod("differentialAbundance", signature("AbundanceData", "Comparator"), function(data, comparator, method = c('DESeq', 'Maaslin'), pValueFloor = P_VALUE_FLOOR, verbose = c(TRUE, FALSE)) { - data <- cleanComparatorVariable(data, comparator, verbose) - recordIdColumn <- data@recordIdColumn - ancestorIdColumns <- data@ancestorIdColumns +setMethod("differentialExpression", signature("CollectionWithMetadata", "Comparator"), function(collection, comparator, method = c('DESeq'), pValueFloor = P_VALUE_FLOOR, verbose = c(TRUE, FALSE)) { + cleanCollection <- cleanComparatorVariable(collection, comparator, verbose) + recordIdColumn <- cleanCollection@recordIdColumn + ancestorIdColumns <- cleanCollection@ancestorIdColumns allIdColumns <- c(recordIdColumn, ancestorIdColumns) comparatorColName <- veupathUtils::getColName(comparator@variable@variableSpec) @@ -252,22 +204,9 @@ setMethod("differentialAbundance", signature("AbundanceData", "Comparator"), fun ## Compute differential abundance if (identical(method, 'DESeq')) { - statistics <- deseq(data, comparator, verbose) -# } else if (identical(method, 'ANCOMBC')) { -# -# se <- TreeSummarizedExperiment::TreeSummarizedExperiment(list(counts = counts), colData = sampleMetadata) -# -# # Currently getting this error: Error in is.infinite(o1) : default method not implemented for type 'list' -# # Ignoring for now. -# output_abs = ANCOMBC::ancombc2(data = se, assay_name = "counts", tax_level = NULL, -# fix_formula = comparatorColName, rand_formula = NULL, -# p_adj_method = "holm", prv_cut=0, -# group = comparatorColName) -# - } else if (identical(method, 'Maaslin')) { - statistics <- maaslin(data, comparator, verbose) + statistics <- deseq(cleanCollection, comparator, verbose) } else { - stop('Unaccepted differential abundance method. Accepted methods are "DESeq" and "Maaslin".') + stop('Unaccepted differential abundance method. Accepted methods are "DESeq".') } veupathUtils::logWithTime(paste0('Completed method=',method,'. Formatting results.'), verbose) @@ -294,12 +233,12 @@ setMethod("differentialAbundance", signature("AbundanceData", "Comparator"), fun statistics@adjustedPValueFloor <- adjustedPValueFloor - # this is droppedTaxa, or pathways etc ?? can we rename it? - droppedColumns <- setdiff(names(data@data[, -..allIdColumns, with=FALSE]), statistics@statistics$pointID) + # Record columns that were dropped due to data cleaning. + droppedColumns <- setdiff(names(cleanCollection@data[, -..allIdColumns, with=FALSE]), statistics@statistics$pointID) ## Construct the ComputeResult result <- new("ComputeResult") - result@name <- 'differentialAbundance' + result@name <- 'differentialExpression' result@recordIdColumn <- recordIdColumn result@ancestorIdColumns <- ancestorIdColumns result@statistics <- statistics @@ -308,12 +247,12 @@ setMethod("differentialAbundance", signature("AbundanceData", "Comparator"), fun # The resulting data should contain only the samples actually used. - result@data <- data@data[, ..allIdColumns] + result@data <- cleanCollection@data[, ..allIdColumns] names(result@data) <- veupathUtils::stripEntityIdFromColumnHeader(names(result@data)) validObject(result) - veupathUtils::logWithTime(paste('Differential abundance computation completed with parameters recordIdColumn = ', recordIdColumn,", comparatorColName = ", comparatorColName, ', method = ', method, ', groupA =', getGroupLabels(comparator, "groupA"), ', groupB = ', getGroupLabels(comparator, "groupB")), verbose) + veupathUtils::logWithTime(paste('Differential expression computation completed with parameters recordIdColumn = ', recordIdColumn,", comparatorColName = ", comparatorColName, ', method = ', method, ', groupA =', getGroupLabels(comparator, "groupA"), ', groupB = ', getGroupLabels(comparator, "groupB")), verbose) return(result) }) diff --git a/R/methods-Comparator.R b/R/methods-Comparator.R new file mode 100644 index 0000000..ad6a6a6 --- /dev/null +++ b/R/methods-Comparator.R @@ -0,0 +1,23 @@ +#' Get labels from a group in a Comparator +#' +#' For any Comparator object, returns the bin labels of either groupA or groupB +#' +#' @param object Comparator +#' @param group String, either "groupA" or "groupB" +#' @return charactor vector of labels from groupA or groupB +#' @export +setGeneric("getGroupLabels", + function(object, group = c("groupA", "groupB")) standardGeneric("getGroupLabels"), + signature = c("object") +) + +#'@export +setMethod("getGroupLabels", signature("Comparator"), function(object, group = c("groupA", "groupB")) { + group <- veupathUtils::matchArg(group) + + groupBinList <- slot(object, group) + + groupLabels <- unlist(lapply(groupBinList, function(bin) {return(bin@binLabel)})) + + return(groupLabels) +}) \ No newline at end of file diff --git a/man/differentialAbundance.Rd b/man/differentialExpression.Rd similarity index 77% rename from man/differentialAbundance.Rd rename to man/differentialExpression.Rd index 17f009d..1bb836b 100644 --- a/man/differentialAbundance.Rd +++ b/man/differentialExpression.Rd @@ -1,19 +1,19 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/method-differentialExpression.R -\name{differentialAbundance} -\alias{differentialAbundance} -\title{Differential abundance} +\name{differentialExpression} +\alias{differentialExpression} +\title{Differential expression} \usage{ -differentialAbundance( - data, +differentialExpression( + collection, comparator, - method = c("DESeq", "Maaslin"), + method = c("DESeq"), pValueFloor = P_VALUE_FLOOR, verbose = c(TRUE, FALSE) ) } \arguments{ -\item{data}{AbsoluteAbundanceData object} +\item{collection}{CollectionWithMetadata object} \item{comparator}{Comparator object specifying the variable and values or bins to be used in dividing samples into groups.} @@ -29,5 +29,5 @@ The default value uses the P_VALUE_FLOOR=1e-200 constant defined in this package ComputeResult object } \description{ -This function returns the fold change and associated p value for a differential abundance analysis comparing samples in two groups. +This function returns the fold change and associated p value for a differential expression analysis comparing samples in two groups. } diff --git a/man/getGroupLabels.Rd b/man/getGroupLabels.Rd new file mode 100644 index 0000000..d4d3b2a --- /dev/null +++ b/man/getGroupLabels.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/methods-Comparator.R +\name{getGroupLabels} +\alias{getGroupLabels} +\title{Get labels from a group in a Comparator} +\usage{ +getGroupLabels(object, group = c("groupA", "groupB")) +} +\arguments{ +\item{object}{Comparator} + +\item{group}{String, either "groupA" or "groupB"} +} +\value{ +charactor vector of labels from groupA or groupB +} +\description{ +For any Comparator object, returns the bin labels of either groupA or groupB +} diff --git a/tests/testthat/test-class-CountDataCollection.R b/tests/testthat/test-class-CountDataCollection.R index 3268076..9d23de2 100644 --- a/tests/testthat/test-class-CountDataCollection.R +++ b/tests/testthat/test-class-CountDataCollection.R @@ -27,4 +27,7 @@ test_that('CountDataCollection validation works', { recordIdColumn = c('entity.SampleID'), name='testCountData' )) + + + }) \ No newline at end of file diff --git a/tests/testthat/test-method-differentialExpression.R b/tests/testthat/test-method-differentialExpression.R index 583dbba..d0794ee 100644 --- a/tests/testthat/test-method-differentialExpression.R +++ b/tests/testthat/test-method-differentialExpression.R @@ -1,16 +1,9 @@ -# Tests for differential abundance methods +# Tests for differential expression methods -test_that('differentialAbundance returns a correctly formatted data.table', { - - # df <- testCountsData - # Create a data frame of counts - nSamples <- 1200 - nGenes <- 100 - set.seed(123) - df <- data.frame(matrix(rpois(nSamples*nGenes, 10), nrow=nSamples)) - colnames(df) <- c(paste0("gene", 1:nGenes)) - df$entity.SampleID <- paste0("sample", 1:nSamples) +test_that('differentialExpression returns a correctly formatted data.table', { + df <- testCountData + nSamples <- dim(df)[1] testSampleMetadata <- data.frame(list( "entity.SampleID" = df[["entity.SampleID"]], "entity.binA" = rep(c("binA_a", "binA_b"), nSamples/2, replace=T), @@ -20,13 +13,13 @@ test_that('differentialAbundance returns a correctly formatted data.table', { "entity.dateA" = sample(seq(as.Date('1988/01/01'), as.Date('2000/01/01'), by="day"), nSamples) )) - - testData <- veupathUtils::CountDataCollection( - data = counts, + testCollection <- veupathUtils::CountDataCollection( + data = df, sampleMetadata = SampleMetadata( data = testSampleMetadata, recordIdColumn = "entity.SampleID" ), + name = 'test', recordIdColumn = 'entity.SampleID') @@ -56,7 +49,7 @@ test_that('differentialAbundance returns a correctly formatted data.table', { ) ) - result <- differentialAbundance(testData, comparator=comparatorVariable, method='DESeq', verbose=F) + result <- differentialExpression(testCollection, comparator=comparatorVariable, method='DESeq', verbose=F) expect_equal(length(result@droppedColumns), 182) dt <- result@data expect_equal(names(dt), c('SampleID')) @@ -128,7 +121,7 @@ test_that('differentialAbundance returns a correctly formatted data.table', { groupB = groupBBins ) - result <- differentialAbundance(testData, comparator=comparatorVariable, method='DESeq', verbose=F) + result <- differentialExpression(testData, comparator=comparatorVariable, method='DESeq', verbose=F) dt <- result@data expect_equal(names(dt), c('SampleID')) expect_s3_class(dt, 'data.table') @@ -159,7 +152,7 @@ test_that('differentialAbundance returns a correctly formatted data.table', { groupB = groupBBins ) - result <- differentialAbundance(testData, comparator=comparatorVariable, method='DESeq', verbose=F) + result <- differentialExpression(testData, comparator=comparatorVariable, method='DESeq', verbose=F) dt <- result@data expect_equal(names(dt), c('SampleID')) expect_s3_class(dt, 'data.table') @@ -172,7 +165,7 @@ test_that('differentialAbundance returns a correctly formatted data.table', { }) -test_that("differentialAbundance can handle messy inputs", { +test_that("differentialExpression can handle messy inputs", { df <- testOTU counts <- round(df[, -c("entity.SampleID")]*1000) # make into "counts" @@ -228,7 +221,7 @@ test_that("differentialAbundance can handle messy inputs", { ) ) - result <- differentialAbundance(testDataMessy, comparator=comparatorVariable, method='DESeq', verbose=F) + result <- differentialExpression(testDataMessy, comparator=comparatorVariable, method='DESeq', verbose=F) dt <- result@data expect_equal(names(dt), c('SampleID')) expect_s3_class(dt, 'data.table') @@ -262,7 +255,7 @@ test_that("differentialAbundance can handle messy inputs", { groupB = groupBBins ) - result <- differentialAbundance(testDataMessy, comparator=comparatorVariable, method='DESeq', verbose=F) + result <- differentialExpression(testDataMessy, comparator=comparatorVariable, method='DESeq', verbose=F) dt <- result@data expect_equal(names(dt), c('SampleID')) expect_s3_class(dt, 'data.table') @@ -293,7 +286,7 @@ test_that("differentialAbundance can handle messy inputs", { groupA = groupABins, groupB = groupBBins ) - result <- differentialAbundance(testDataMessy, comparator=comparatorVariable, method='DESeq', verbose=T) + result <- differentialExpression(testDataMessy, comparator=comparatorVariable, method='DESeq', verbose=T) dt <- result@data expect_equal(names(dt), c('SampleID')) expect_s3_class(dt, 'data.table') @@ -308,7 +301,7 @@ test_that("differentialAbundance can handle messy inputs", { }) -test_that("differentialAbundance returns a ComputeResult with the correct slots" , { +test_that("differentialExpression returns a ComputeResult with the correct slots" , { df <- testOTU counts <- round(df[, -c("entity.SampleID")]*1000) # make into "counts" @@ -355,13 +348,13 @@ test_that("differentialAbundance returns a ComputeResult with the correct slots" ) ) - result <- differentialAbundance(testData, comparator=comparatorVariable, method='DESeq', verbose=F) + result <- differentialExpression(testData, comparator=comparatorVariable, method='DESeq', verbose=F) expect_equal(result@parameters, 'recordIdColumn = entity.SampleID, comparatorColName = entity.binA, method = DESeq, groupA =binA_a, groupB = binA_b') expect_equal(result@recordIdColumn, 'entity.SampleID') expect_equal(class(result@droppedColumns), 'character') }) -test_that("differentialAbundance fails with improper inputs", { +test_that("differentialExpression fails with improper inputs", { df <- testOTU counts <- round(df[, -c("entity.SampleID")]*1000) # make into "counts" @@ -406,11 +399,11 @@ test_that("differentialAbundance fails with improper inputs", { groupB = groupBBins ) - expect_error(differentialAbundance(testData, comparator=comparisonVariable, method='DESeq', verbose=F)) + expect_error(differentialExpression(testData, comparator=comparisonVariable, method='DESeq', verbose=F)) }) -test_that("differentialAbundance catches deseq errors", { +test_that("differentialExpression catches deseq errors", { df <- testOTU counts <- round(df[, -c("entity.SampleID")]*1000) # make into "counts" @@ -454,86 +447,13 @@ test_that("differentialAbundance catches deseq errors", { sampleMetadata = sampleMetadata, recordIdColumn = 'entity.SampleID') - expect_error(differentialAbundance(testData, comparator=comparisonVariable, method='DESeq', verbose=T)) + expect_error(differentialExpression(testData, comparator=comparisonVariable, method='DESeq', verbose=T)) }) -# test_that("differentialAbundance method Maaslin does stuff",{ -# df <- testOTU -# counts <- round(df[, -c("entity.SampleID")]*1000) -# counts[ ,entity.SampleID:= df$entity.SampleID] -# nSamples <- dim(df)[1] -# testSampleMetadata <- SampleMetadata( -# data = data.frame(list( -# "entity.SampleID" = df[["entity.SampleID"]], -# "entity.binA" = rep(c("binA_a", "binA_b"), nSamples/2, replace=T), -# "entity.cat3" = rep(paste0("cat3_", letters[1:3]), nSamples/3, replace=T), -# "entity.cat4" = rep(paste0("cat4_", letters[1:4]), nSamples/4, replace=T), -# "entity.contA" = rnorm(nSamples, sd=5) -# )), -# recordIdColumn ="entity.SampleID" -# ) - - -# testCountsData <- veupathUtils::AbsoluteAbundanceData( -# data = counts, -# sampleMetadata = testSampleMetadata, -# recordIdColumn = 'entity.SampleID') - -# testData <- veupathUtils::AbundanceData( -# data = df, -# sampleMetadata = testSampleMetadata, -# recordIdColumn = 'entity.SampleID' -# ) - -# comparatorVariable <- veupathUtils::Comparator( -# variable = veupathUtils::VariableMetadata( -# variableSpec = VariableSpec( -# variableId = 'cat4', -# entityId = 'entity' -# ), -# dataShape = veupathUtils::DataShape(value="CATEGORICAL") -# ), -# groupA = veupathUtils::BinList( -# S4Vectors::SimpleList( -# c(veupathUtils::Bin( -# binLabel="cat4_a" -# )) -# ) -# ), -# groupB = veupathUtils::BinList( -# S4Vectors::SimpleList( -# c(veupathUtils::Bin( -# binLabel="cat4_b" -# )) -# ) -# ) -# ) - -# result <- differentialAbundance(testData, -# comparator = comparatorVariable, -# method='Maaslin', -# verbose=F) -# dt <- result@data -# stats <- result@statistics@statistics - - -# resultCounts <- differentialAbundance(testCountsData, -# comparator = comparatorVariable, -# method='Maaslin', -# verbose=F) -# dtCounts <- result@data -# statsCounts <- result@statistics@statistics - -# expect_equal(dt, dtCounts) -# expect_equal(result@statistics@effectSizeLabel, 'Model Coefficient (Effect Size)') -# expect_true(length(stats$pointID) > 0) -# expect_true(length(statsCounts$pointID) > 0) -# expect_equal(stats, statsCounts) -# }) - -test_that("toJSON for DifferentialAbundanceResult works",{ + +test_that("toJSON for differentialExpressionResult works",{ df <- testOTU nSamples <- dim(df)[1] df$entity.wowtaxa <- rep(c(0.01, 0.99), nSamples/2, replace=T) # will 'wow' us with its significance @@ -576,7 +496,7 @@ test_that("toJSON for DifferentialAbundanceResult works",{ ) ) - result <- differentialAbundance(testData, + result <- differentialExpression(testData, comparator = comparatorVariable, method='Maaslin', verbose=F) @@ -640,29 +560,29 @@ test_that("The smallest pvalue we can get is our p value floor", { ) # Try with different p value floors - result <- differentialAbundance(testData, comparator=comparatorVariable, method='DESeq', pValueFloor = 0, verbose=F) + result <- differentialExpression(testData, comparator=comparatorVariable, method='DESeq', pValueFloor = 0, verbose=F) expect_equal(min(result@statistics@statistics$pValue), 0) expect_equal(min(result@statistics@statistics$adjustedPValue, na.rm=T), 0) # Confirmed NAs are for pvalue=1 - result <- differentialAbundance(testData, comparator=comparatorVariable, method='DESeq', pValueFloor = P_VALUE_FLOOR, verbose=F) + result <- differentialExpression(testData, comparator=comparatorVariable, method='DESeq', pValueFloor = P_VALUE_FLOOR, verbose=F) expect_equal(min(result@statistics@statistics$pValue), P_VALUE_FLOOR) expect_equal(min(result@statistics@statistics$adjustedPValue, na.rm=T), result@statistics@adjustedPValueFloor) # Confirmed NAs are for pvalue=1 # Repeat with Maaslin - result <- differentialAbundance(testData, comparator=comparatorVariable, method='Maaslin', pValueFloor = 0, verbose=F) + result <- differentialExpression(testData, comparator=comparatorVariable, method='Maaslin', pValueFloor = 0, verbose=F) expect_equal(min(result@statistics@statistics$pValue), 0) expect_equal(min(result@statistics@statistics$adjustedPValue), 0) - result <- differentialAbundance(testData, comparator=comparatorVariable, method='Maaslin', pValueFloor = P_VALUE_FLOOR, verbose=F) + result <- differentialExpression(testData, comparator=comparatorVariable, method='Maaslin', pValueFloor = P_VALUE_FLOOR, verbose=F) expect_equal(min(result@statistics@statistics$pValue), P_VALUE_FLOOR) expect_equal(min(result@statistics@statistics$adjustedPValue), result@statistics@adjustedPValueFloor) }) -test_that("differentialAbundance fails if comparator has one value", { +test_that("differentialExpression fails if comparator has one value", { df <- testOTU @@ -692,6 +612,6 @@ test_that("differentialAbundance fails if comparator has one value", { groupB = veupathUtils::BinList(S4Vectors::SimpleList(c(veupathUtils::Bin(binLabel="binB")))) ) - expect_error(differentialAbundance(testData, comparator=comparatorVariable, method='DESeq', verbose=F)) - expect_error(differentialAbundance(testData, comparator=comparatorVariable, method='Maaslin', verbose=F)) + expect_error(differentialExpression(testData, comparator=comparatorVariable, method='DESeq', verbose=F)) + expect_error(differentialExpression(testData, comparator=comparatorVariable, method='Maaslin', verbose=F)) }) \ No newline at end of file From fd7d49c3c490287f070aedfd075e9f1da4086744 Mon Sep 17 00:00:00 2001 From: asizemore Date: Thu, 31 Oct 2024 18:16:25 -0400 Subject: [PATCH 4/4] differnetial expression tests passing --- R/methods-ComputeResult.R | 21 ++- data/testCountDataCollection.rda | Bin 0 -> 53240 bytes .../test-method-differentialExpression.R | 165 +++++------------- 3 files changed, 67 insertions(+), 119 deletions(-) create mode 100644 data/testCountDataCollection.rda diff --git a/R/methods-ComputeResult.R b/R/methods-ComputeResult.R index 4f0c0f8..4505e83 100644 --- a/R/methods-ComputeResult.R +++ b/R/methods-ComputeResult.R @@ -133,4 +133,23 @@ setMethod("toJSON", signature("CorrelationResult"), function(object, ...) { # these let jsonlite::toJSON work by using the custom toJSON method for our custom result class asJSONGeneric <- getGeneric("asJSON", package = "jsonlite") -setMethod(asJSONGeneric, "CorrelationResult", function(x, ...) toJSON(x)) \ No newline at end of file +setMethod(asJSONGeneric, "CorrelationResult", function(x, ...) toJSON(x)) + + + +## For the DifferentialExpressionResult class +setMethod("toJSON", signature("DifferentialExpressionResult"), function(object, ...) { + tmp <- character() + + tmp <- paste0(tmp, '"effectSizeLabel": ', jsonlite::toJSON(jsonlite::unbox(object@effectSizeLabel)), ',') + tmp <- paste0(tmp, '"pValueFloor": ', jsonlite::toJSON(jsonlite::unbox(as.character(object@pValueFloor))), ',') + tmp <- paste0(tmp, '"adjustedPValueFloor": ', jsonlite::toJSON(jsonlite::unbox(as.character(object@adjustedPValueFloor))), ',') + + outObject <- data.frame(lapply(object@statistics, as.character)) + tmp <- paste0(tmp, paste0('"statistics": ', jsonlite::toJSON(outObject))) + + tmp <- paste0("{", tmp, "}") + return(tmp) +}) + +setMethod(asJSONGeneric, "DifferentialExpressionResult", function(x, ...) toJSON(x)) \ No newline at end of file diff --git a/data/testCountDataCollection.rda b/data/testCountDataCollection.rda new file mode 100644 index 0000000000000000000000000000000000000000..62a893c118e0ee73dfba8a0eb25ee9846ec98657 GIT binary patch literal 53240 zcmZs?3p|r={5QT*>F`D0RLZ#|k*tt2ODajuNpkv@oKHEM!=_X^Fd^hDhlsMs`LvD} zGjnV)OwBgTwwRf1w*7DYp6B&{p4aQ~a@nr?z7F?w-Jiqz^Zs0vp6vwv{SjN57JoT4 zHm?7t>Ot1t#x46Upa1?~@A>te%y@hbg%p}{hBiYFXRgIhr-#giIt_H(TM&Ew@?dW0 z$N%n09NKzk;q|shxrfeYNeFD>`Yb8(5|@n&GJTJEVCO{%iV(C*M+YY@re7gFYP^n= zT+5VP4|R2&F!SLvKEzI#5xG2+4{?D|&0^ln%b|C2@DIED*G?J#p~bBaoYC=(d8rq) zIDk;`Ma-WLS(!Ui;cNR+uQ?c*1iSqv{!iM!PJzcW3?l~y{;fdO7rwbff9Wt9Xc;Rf zh&KN4`l=w_ire}__}{=-zO?V4aYJlveyGAJIc8yCQ*fyTN+^PLEqI=(_@zVOn0@F- zxOma$8?!)ApFdm%4S1-j)vDRzHZ$N0t-`Ko6q2zaxvlSAXGVOXCkx5%fJ$GNT(Dy9 zG^62N*ax|SiKR!rdY!NGv7!FH|5x?B6>7v+|Jvlzqbr>;!7&z9*wC7$35gt_@&CSF zIQ?I?Zw_$1aYDiwxZYo%R5)$#^Fgi_X#f9T|8%^V0^Dr}rU(V5AS^wi#0Y?K|L==C z3Pas~E6b1J6X8uHc?6Jr}X{kr`&38gx+`;EYx@htkQ=4LrBhOugb&G;H2e+vfq#Awt7k2FB9>6O~# z{7+E_KGky;aQm%|^sr6utwt%`-Hi`zT2BR+?9pR#^+*-{xq1m`ifQ`@#dN~=rE>tQ z#65te2u$P&Oyuh_F-b8TpQN-;Oui=m&`TgvuuYB8l-TAgh58fy17VFhdSS0~LV^{q z%N6PpelE4F7B+Hi^jL#$8ln2{8o9mKeOT%5`YCd5IoQs(SpLNvto}QV!q^F*jA|4P z-vllP ztoHvbftg&LX-1zn>y5Jy%ciQIQh3GLx-iv;CGi?q%heogwGU87m1C=Grh`6HoSJHL zuwKKI&F9oF(I~Vd0rQ#wbB;K_TUu#_wry_l=1t|Ye&4H?$3%DJ<6&G&g43@eBU_Xb_e$2 zls2UQV7`*ivw@7pixkTMmLAZ;%OG;}ln!JqH(x0MGmz2kLqX4Iv%JIdxecvNR;T~h zw}FkHI<3PRKrIKj-oNqF%?GyhP8+gz9q3jEbjz`s`JZp5k>nr1HyUs)8W_q5=u*sW zAaosR9^6oNBg_?Z&3$3FTKhJX33p)6L$o0UdihE=g#++Dy$~VacH^DWn>9JZTY;Uw zRIXNK-bju9fBed1Mdvb?D=rPZ<-NA8)g8Ge`>>$q$^YZGKTuDgNStcA7&&?nYZIcc zWF||vWgMJJf3MK;CFZB(|54cz>T*5i4;+OK6Iti!v?dO7ezu5=<03>omL>H{V@bnc zGgHPvqu=B_gcgdSZZw<1#cm0MEvHDsqx#gNR$sZ{mrS}#VPoc_sK~xOk(02s zesL7)7R}+B@Kdbh{7P%ass(4`(kSeGIA4t_r8E{Z-$uvvKt*7Tv0^QgJyuuerVt%O z$Qvx0YWY1a)54rE^B?=zfLUGnDupx+=+BG#vy_V?vc`#Q0sM3`Gv5L-EM*eM$GES^5cOu`x>Pm$ejMCEkU)A1|LJ}tr9x*$u-y*rpXqa!d@2`wv z%?vNMP-cl!GU-O|79>Ay5l9N?W~;?}AU~_pH>TI7>aXQGD9!sb&0{9t-yt{B?_$>(Nyg|1r>(tR*H!c5k?=}OZP!%SxB;ZY8E z?x}O6CA++$=O*_C^MmNeTC*sanZVudHDZ?P zEEQu0!tqh4EJR|=dXeHu&V1_eMFc#Yj+>|MK`>TU!JP}KW*iRF3nk>y!-^((B&<#W zO>N%7vwKcpOMuJ>gGH%pi6d(WeX7D_E9;!V9o*=~eRA`uS$*?A3N9nigT?W>o!JcMz zp_%Y;kLc(8t>V1qFg}Cwg{jyUzfX{e_5*9lPkV?Mzwx5jvKC877kN9UnJbhCL3ObZ zYgkF-Php1i+SSQXzsWTm@~M*PUEcXgs$HIZ;|7U2Z03Cs($h#OXmLZ~N!03%2#|sS z?@z$EovFFFD0I1`Q`mYqhq!^l^_VU0F>2x=XvdSH3d z64S#X)G75`h5YU!;NKb0+vrNn$kj#{(YPn%4tsieV)f{+#Il$n{EenJevqyO?<7%deJFv#v|EI5r$1D?|1hwIGzRjd z)C7w+dCRcYm|`=YzaRl3Y$Co_@~Bek`VZsqWRXFDFi{*nBtdi|Nz^TzSwxO{;yLl_ zAHZ7fXKwLDjI-T#t=F4*TP*48cUOj3Y$a6)kNc&SU7e!U5jOylO!VWsksyo>vY?Qy zl3m?>np|OBvmql!WElFj3o&Ozi(JeEdftcV1)K9wN^BOex)-U)jq%-r=f!x5b$+RM zvmmjwZ+b>xkpmmUg&vAnp205EWZDTjzo|T%6cXoI2x9A(Q~UY2Xz&tb!_nw2mB)XC z+c=k@szjfp6!k^Tdd={m(><&JWJcKf_(H|&;aev|Czl7F;fFE?p?(x;{bGv*j_JnF zSlEYD$t8RK+*3IzJSU8e0t*G-Q|4t_b2!2UH~u_oYGdkwhd8QQNiZ<~B(?SBThZJ% z>z-gp0^A5d9xX|*)>a{jIMuz93W3G(T{tMc+q14pO-a!+lpoWfC>x^RkXjf*G@K}S zIW1bJvSWkGzKAD)x@dzwRkd1t-P#Mj!Cnpl8}erN9G__~6&4>1A{sHi zCN0!3ER+0ZT!Y?hyd@5KU2-o|Vq=B{uvIFAma6ojVxrJxu&R_Hn#f4?T6YpWS0NU_ zXGMj?wLw&m2@F+dHk#3OcTUDdM2_RlG;;Ey+y%SosL1J!6j{cEFyQxWX1a^1Ey`di z-6qGHIm{`(8N+FY%(MwuThd2Q9xt|o%)sZjK=?2GnOme*MQj9ZAyu5QfkE()^VDu( zJ0;VyrCAVXg%c%I5m-^PD9KLW-xNGs3~4;StRCBaB_VA6SEbAkj|RcBkZdpEH>4;P z*4TwDmE_{y(s2XbwP?>m&#=ylFW#iQQwBc#4l}8!pYdqqs`m~}&vtzFNw$TTF`1|~ z-B18)h6>F@`QurVfucoel9?%zE?pts0;h2^T2PQVWElK?3}cN0;r~iG3o%Pu>-dlD z%ABbhm9mx9p8wgQ>V*QE@NO6SLZ*aNxg9yGox;naK5);Ksm9-;g#aEsk5 zSS3GIvf)y3Y=QVjBP$aw%7%SU87-ZFO+tCUi2RwuN~=Gslxok~8opXl6qM!nt#~O6 zSJ6ca#yFv%F<$UoUpQ3D_)H8It&*5M6M$!HNnlLFv5)+C3lQik_~cC~rj;ckj@QQ~ zmfAv!^=ETbMaB*gURj9J8t>Z{o|(l=@N@(L*CHYYEwjPb6-U;PM0n-zMfkfPQl-%} zDa+NFWyxbmyPb7Pnd?#d%ktX4F9U$Kp|*m^vSh{kKp5`LkZ==Zbqc+Adk)8PZND=2od_F z_K4>31xoLi(W@kDqiNQ}D$-xnLY<03SLZbgYDKByie|B&*1(>8qL({oBaZh=UU;Xb88T#F1)l< z2rQTnfya(a?a38BUE`lxn=1dF(6SIJuP&NuwbIxBPP}|dZuo21_vhya=0=?^~SA#1^&IC zo_Qs;rNOGEBZrFlX=N66MA{2MY@&eM!&;P+fyXEc8hfZc_(YCX5(+XM{%abaST9PP zI(gtjOw2HR>i5t$8Tf`j5Tw5e-)nj|Yyv*q5`o|#XV<@@49)K9p;MW;WSkYZQx=_S zz*z4LMx~Q1I>wOX8qTjambJPUdb!7A1SjVx`Y)83Njg?fC1)tA3OsPj!$0JsvtkOv zxu0mN8Lg_Jzt(4wRRSqhk#yCDG{X28vlunkCO|d{_PL7ow~9WV9ho8C;b)VVTV9aG zFAH|`QKO+nBSJC!705`v7N7pBTGdm7Zkt0ts}BE0E>^PYX1LERD`|!C?=`_2n)ut1 z#F*L_rO)Z`@5`^6M;QMFR2PxHWZ_jDnfFG0AOksTxIBRhu27trml*mY{+$mzI4gd7 zZh1ySfYRU|qDwuGk<5w@@ev7bEIMC?$y^pGS-%hz^c zCHz8DE#1*aSno7bfi9`Bsn*@Xkr~;(1X(2UhwIAvE-*2sW)7a)#F3g%%EAw-R0_}4 zi~eY65jpqYGEed8<^h(TeuRU4G5Q#uZKIM99oIEN{Nkv1DuX5+;3Bj&CPXGknX1w; zq{-vBy3|Yk5l}P6`n%PHj-^!oF{Wpu((gu3PcP$IXuFxyWDW|CQ1R(Bt}4bHE8R6R zc+wH6pQqGry#miBeOXD2zx&d}EDIgJC$F`SMu9;~Of-?LmQtj6;~(LPO{p))0upRO zM1UQk_tVI~aQ zp?REP%iPN_s{mwOFqknYsGd1R2{;{q<#~NBF)AvgCe@o|b1qj$Z%h>F71%qV(=LuR2_y zaI(r{0+-RHM(ecVgRM-Vre>NrQt^gS^VR*rVux(YftL=~eGA+ZiJQb2*9hkG&LsNl zi!+zVf;+de^S?uvId_)f$lVQ^vS)AmI*(rLP5f8<@Uz!8#S?>#!K-*^GpVwNrDQ!q z6fj><)e!FlMi;Fo#ediqMwVytI4EH&2hJIS3t7(EU%WSdJ$_TsJMhx*-H(@X({Wus z#MMqtE8n!O6?!~2GLnx^J9IYSYulOJJ5mLvzSpsj^GW={qSMeFe#6JIld4}UKIMX0 z#KV;KnI6$E?lgzXVLNPnuGS9 zpfQOc(C%CE+w3d--!J|H0zLIS)@!cY>JYsf1X8`X<6xVq7c{qXM%j-I+P(it_+Aj` zh2CP>8`~{UrF+fy8pzhy*=_-WjwTxgw%7hAzYS!6q2~3?=-tp)nN|pIQa&DB1Ad!S zvhZR4U)(y+rv0W%mgNJW-QIt{>h!0ST?`*rKX(CqqN^OsUectu+4_ z=-X5dV2s`R(bmD$KK1ad3xzcMfEtET>sX8q#;_%G#m%qRh9>ip(Co>yv84Em{;9VU z>+|p&rD=na>G_zm6ND@~aWdee#iwq!0$ zfjaWIEg&hIUSFr1hwe4#We>1j!p*Mbhesc_X_=_c`Pwc)A?I>O=f8NV*^vLGusvUW zAWh(ri0~JIx~{+X526{|i)R})Rx+_^9Qfj~VQsL4b9*qSqpkfd%1;Z!7qht%QREro z3BRR+wwA(72?Nu;Bh|q=kYDLkD_&AC>}WzyUROzyVD-^kTHzS;IQK9zlC(T&VyDm= zl!TJYp7ZDO=lI<04s={E>P$bF5m(hL)?Qzup@pZi^NgTf{a(1-o= z=-?k7<2adS{6+|>u4)R0XIxRl+7w`Hyug`<#J41OC*oKdF=KAgJA8G|zBYPzS!WQJ z^8J&+PSDXO_0w;Rw*R?DV0DiYu*fxCsS~n5m;H}(>5j!)L7+Ktk}~M-!}#pQ{UA`+ zK0q&u>j6RQdH5)E^9o3Ka&s|5AP+#k#HPSIKvU&0wK|{-K=Nm$7fF%)iaw$w2y{gW zklKGOp6#o30)ciudrK<2&y4hmELBDmGHeSlTFmP6mivF8+}as=x%Do;{0F}kl6#j?h@mR{r$v|wLx=O9!r<0KrC@h=o2{1=6<)+JZ`!jSjr@FoqN7a$ z)o}bPRjppvJ}pmOLi7qg@#f`SV7KZ~fzFheB?csR*gQY4^ksOsze7lOyGhPeh}SPy z4N8pnK2|sC#z5UwlT?zqmc5Kk^zQBIt3r&f5yeXJTR+|4@xd4TEO8JhZU?X>7yVBI z+W=BtJT1BPy}9=_KVUD+z8IX?Q*aef=&iHyaXVFRYM+bVePumbVrjWeL+%j&BpS56om5;y>koJZDa z#f;sI-tk-_q~NX5_MK{gAb~zcHrcxrZ%vj4UKQxv{LtqefOXMrlNEnR<`tH$loh;e zH#z$fR$SgLQR}pGTXClq@OriwSvwVPeE@34cZDF+FJPEiQID#pPf$66-70|Kmfg8E zBbGcOJtnYK)_#FVDN@A0@;*g=NquvN!MTcc?~R+1X)h6PGMZw&dw$*P=NfkgiLRji zo{z#7K8j$Esy+`rk9!F@kwk1&9be1}zh|2j7rYj4NXW03DYAZEWaddS3s{J7V@BSa zT8V>vTULH-GP#!#eh~CP%4P&G-7_Bzc7EKEJ`8*{D@WAoJU+NsRcHI@SQ3iw5MBjM zjsO;W?wEtr_~8p;&NM)fz5_2JdFyb0#JD=>+(-YY&xEzR!d4AnFXtTgY?{&Jqrmt1 zq4M281JF6$|KwjhJi{yuhZq}O^w0u*8+^&sTJ*o@2zY=$5@{(<4~_R;tKNIXb2@dR z4tnSfl44~Ht5CV-x7S8D?OOHhl^&M(@S>Q3R?V*yEURJHeJ(Gl$TA-?W75kZ+sm_> z+MFNeua}Q$R%}&T<{$A(4!1uzW*xl)kc?TCw3NoOZ0AiW0hxUU6i@k_Zs+;`H8JSQ zwg9WmN8Dd%pOJE+pkTLCup@KHC=zNRhUT8}6AT1=?@A=C4`9%H(NHpl>@*;7uuS(Z4)yHO8eIO3 zIYkJftXyNo#H6tfs)tSp|9NNSG0HozD-wE1GeJ=0W;h7e2czcR$REC9n$A(fA|i_l zzPpD#s9IVz%gJNTov6l)6o3b4?{LIV9qoy?rrZ&%_`r~b>PLiEneL?rb&aftc6gNK zW1>9_jZ9EE2btP=e&gZtN6EM1DRiToybyH<2Gh#)6wS0}Ca0d#^^O%b91YjctG1`m z69OnJ+c3Njr)apl`DM*0=L3|+aIbXZ^({kP$Ivs-7WnJ0ncR@lQ1l37{ObUDJA0xP z()?cdY`ZhLeY)}(da$73#2BES$&MEEklfgvdQzxa-o6vshtcM`S^-*NKV|KWex1{i z6$G>n=J{gg%RdXvn#}T(k`UqgSUi^e@C+j538{Yv!Y|Ldy{=t&`HdRduSTua5=~f* zO@QftuY?{LToec=yC&_z;DWu8&`Mt|;(KFO4EkqNEXHMmALRR?s|QXYLp?d}8eIi0 zNBkgalbX!e`4~Yo;((*#@rI1hdi<#Sb=4$*;8e$|EH2F`CDFo4e6;}E(60iz0xY^lz2;!LvaqS z!>s88P3#|MmZ4JL za!fAXu7?`E|7pCxu!**^e2D5jS&w50KDC$@65SSbtqpPbjA@hQ1)MjA`g9uVX)_p` zjXO(YO}>Qdc(g!G9mTB^)=2-#O99rC^xd^P$W-y?)^o!SXM0laZ$hKY3#@FwkRH9X zhvr;u?>Hrd&AkGYqeg~H=)rQcVo)hVzfTEONk1wV0`l{!@h(mjvY7z!0^EwSqw?INd;J}9q7X68tOz3|I0%svXy%}FL9%R%b#a>nhflx!e;0PCBiv*hn9I#PW zb{5wgi2;_aJPWFLkrrKkaxtZ^x4`mYR_Kvq_e<0?gZ*E4{#?`P@4hVdQF?*962Cs) z!?61@dlE%G@WB`|>vq@V#ApBKuK`c;oGr8gM%qNW7i2t&t`%>sc^JO;T&8yY==Sf& z16g;rJ?vEj6y*Zdd*EzF%Xz^3UiimGZPQRa05G+EV~y6VocWdqhw6>*ohX0P(Qcv_ z@b3QRaQjWuSju*rFyi~C=zI`pukEHC{+0OOA2DpLeewBYLqFrz*wwOZO^jMl&zzH{ ze`W7-MSpw_^g=R{q-^x5I>w_UmZ6)mn)EZxza6*xRN#O+s{8A1>x5kHtGAp59m+0U zhVeqK3tyio?4C69H!J>f@Q{t_8_iPeh>9NM;{AQSi}MJCZ$$I(eq>3DcH+0awz1(!^g_3*+qat9^l z@daKlb&q~(xZbZt#aF)ROB~_*@_9@8F_q9WkrONN`V2W+nLpCmdih~d*7`lz<&H~; zvv)kfsFTAXM(8T`1nbRsV}0v%=ohuY#lsvv!-mV&L6%e$m0HRu_tmVz4RzUNT_V_Y}~?`+<1!c^ZiHj@{#g(k9XgUxBw%htAt5E+1U~LaB=^OvO28T z(VP9HsZoNh2pN`yXTTZwUi*?Sx|7NdCjl>$uO?q@y`Gf4&(bgmS<0vvH7xMfJ^le5 z?ORwr2Fj@^UHs>YA^?N7muFTQZBH&Ye>u2y>xHBycjv1l<@lHI(keH#NbVa!TcWrq zxkxA=QK}6*P18u13`1L@|3S0*4MVfy!Sb)Ge?MZin>hXO5*$H4tD26E=%O3hKDl(v z$5ct`^?^vkcE?5ES+o5CUyHoOs#K6 z*A-X`6Ab#f;A<+}F_w&5hkb4#Joidz>xGnKvQ+UyRIjDq(jNZ45|*Sc>2|p3G*(T1 zsJ+8PSQ^n~$wLWD5gZKnY;2#f+Y(VY)Ao#HvypI>7b~lh0s9*MVIv9r`$0NOd;Yl4 z9FnB?!@{Cp`<3m=I`uMlF{nz|>F9Zsu4Y*O!UW&P@_S}d3KQL%8^sh^o?r1)BfRsU zi+lHi`JB$6oggqNann}&!hW@RQsbyw9+{T0`}WNE{5!-(fD zII0ux2nA^+KT85%GIG}R`-Ds_TIcr_iF6A6hZX9}o$igaOVRJDh=_#QMa1*4h zVrv%yoP&lkHT&EYiBaz~rE8V2%k_}R#LH`Vt45*w1en$u5gZnZ{;uMoHz+z&B6Gko zm$mIg=mIgK$0eH;G#Bk-TKd>GvprY~_F*axGU;#D@bGo-0NHjQb)m6Dt`cKeNIOim z{0CR$(lK-RCgp(S@D-tgzQE|E`2>yF_?XlUzU!`r8;w`@0+)inRQ4N$weu_B0DWKx5|Msug7|NgK5vj+LlkaCs{Vr>aEejqWfe@r<2LbC4nP z`Hz0)rJ&pL(#3|Mxf~=<&CpW?nNg=v34taBGrokUbP+RNbZO-Y&b~P21@$tu{^1qI zE#^OpN67Tk<{bM(*I{B+d+v0~wOoFIJ7TjK666y~9o{8NJq5>)uk_>?T%NR!*hs1{ z=`l7ibJyZx_`Mw=^2nYiBm^_EGl-nDA`2}U$U{TBmr6rc+U-SU!JN}!u`vpH;7krv z+%wB$E{W$mA>0jx==E;T{w<%klxcch7M-$ThLQ%b=oLpRAf70@t7`>>2Iq#$+INks zC+h<-&EuT~4%J2v?O!SGqa&-gKbA*Q;U~5NCO!FNFE^_8F!kHH_eF!%+w6~NV)@kq_(2D~LNoVhm%ymo%3$jd#wCf|q zb*k~wBhhXH2lFV50)xsniFEpORA=4~d?j>=eu-RaV*f#kQkX|a@V3|dr}?X&DPjA?y~ zJHtF=lTDwYJjwHazM9Zj<>~iilx9%>_BmbE%UiM3%}039TUa)CJd`tv7=N?=c7XVY zan$sHWnTs@A2V`J_Lo@AkEN|C_I6u)R@e2IWu zI(c(1sqH+)Evq_&w_H?ot3sruRH~^%c9x^Y$w-0vN?aN>`%LMeHR>#$@Alz>hOOOQS7H4E zTL!bCVD~5e)WVf~w*So#+Nq+w7rIQMt16I^bM~k#N>9Fi5x66JU=|bD0Syw{)TqR-}icfEuYQ}Ny9gU z!?QkA1#g(nMF$Q%8=nhz9jtqW(!8R2`DA4`-6c|&QuhQCK}upXH+n5wPmxyMd4+d5 zQamQP&#noh9uADI?L_@M{MI1v6z7OFbvfP?AGH2vjc&5gSKa0gW)Z&A5WnLoF~`-g zWTPj&eDb)q((~ommu}e1%3x?|g#vjBPI_N(ZDaM*4Gm8KxL-@e7&s~qgUc?B7 zW%H~3-o9Xp#)|NClY0*F!pbxIQms6DX%{FNMd5wd`*OJ7ivhsmULO-!R2uMIl_>`mO`M&fm_C?+)%A|aNnbo7kmN?^%FQi64Z zHbM+qf|o%Ag7IOj+;6RvB;d2R7W4)E?5pZ3nndv9-1!8>2HxlylQ zeHh?MK`%6G2VK7rxhYRqos@1!Ibtb zmXU1yP>3Ajz!D7J>gOh6#XhI!Is-g!V;Sodt21>;xUDJJnsH_JP_yHYvzrW-CVf3Cm6oF1IKLDaM!>LoniuHR zs-}G^n&mLBedGHFt;OxH0u~*VoF$#hpFckjgjfGn4DkoHe#9dyoUZxJN-e%K68p0g zV7Xn#TsQfOvO@s8kC^`lpuj*NdwHO9^5t>{AR@Of=}712>F?2#Isr5R?cEtz0YoFo z$AL9wUHkw|gc}Af=N1KN@_0 z=vXW+26`%m@Y|kpb5av6xMjUb)9}+Cf9J6W*a^1X1qiY8vD0ri&wpYp(OvZFZc0Ex znf&Ja+G}*pt=ee&;~kqM9BAc2`1s*-_x>&({bmpZT6(}XyQupZc-&8$9M92*9d8E9 z+J;s)`KR?=04)JZeqIJ}h4we)H?)Aj>)gHh#fDm^6T7dy1Bk8%MgUdcb>V7GoaKJGifQbu8{r zz9oO{!CfIzwkfb{asNk)G0*57gEa-z6M_DT0M}HuSm;z2+F9_v+*yLM((X2XY@Y&v7(k%53!|I)2Oxe0 zcI`aE)}`3IPvc3ry*<@+KPIXB)#<3p#eb$=`PS;(ePje|WKa6-S{?gm8qR)uLymMX z+JQt3NMkrH9(c+J2eFrHZ9mEAR)2Cgv$9dNKfQ@xj;Xf^4?aD_9$F#PyTAzM{+kJ! zdw1hK9PDeF7yl`HIefno*bzA(4DDm_+d!w*T9f{y;yE&VhPjfNmz=k-b*%QhR@pR1 zX61c1PYcqX@d>bL|48oCZZE#mb}AQSU@7+9Lom4w{qT$*J1?g*2yXk?Im!N6DD0DK zcQadf{C>E-)hEvI=b^iR+FU&H7N0cS;WM}>G2BIuz5UspfixxzGD$CvfFA4vRQ=}Ib%0csaz>-B&|wWxuNVJ$nlc^zc+5pgFT(`c zDNf$h`g0E$9o#j5&rjY9XxaIU`a|VL+d;|aX1f?4H`8qCqge9rE>-9S4|~)H`*#Pg zS}N`uhCV_J#R2(%SLgNwZE7wN5ab7kI1-v`wAIh|d4YhyTN!vwrX7uG%dU-vPtq6c zI_*~g_i=i$`mfrbs~R(S%rF{idQSOj==mduWMgb74ADkY8CBO36XG-vFiFyq0phI| zoUZJHu&L`G66>FNTrge{L`qL*tAp^L@uiZYgPWP%Uh#cv-~^t?%hjhn_U-&2=wmHPej z>Iwu11ATvlySL8MAmE|&700TZ;=JYMyUTuit;Evfg(v6cqSyu1V0;L~8@ z`*hOOAvB{gu{Lxu@1Ux|;QQdP1+;DUMmm0ap#Tasj!e3FLeSrp(Q7i&bfF|Q7kYN# z_+Z9CAOO=s>J&l?YYHzIf*)z+ah?R6L3qa*FZxU%wDT6WJ@G!qOz4e#dnW9hMb$Kc z%=)!fXb=j?AgSaP?t7gYHuuxD#qB5;tC>ea}`6mj4 z^ZYl8nH%>ErP_rEMlS9{U26fJ7_D!~g%!iRIuRlZrKP-C^hqYzW$Iga$6PEao3fUM zXJ2v^EuDsTWuecKD_>lgM>q_!q&Uj#@u$8wx$ zHPcu+i*KAGONw28-_Pz$4WBk-s8A)-fn=g2yr)d(EH1Lo@~3b{H%lAbnlE!tyY%?s zLnHx#9V4dcqhW9$GC>k4Qz5x8L@{-dbGDTOz8dE8D?qk~#bcq8(HSIjSNkySJn=Vu zDvSOV010`5&*Zi@d~PYNg=Sec=nTSlB-`&~8+>oms-2D5-6aa^DCPpJ-VrX$s&1}h zXZxU*pWr2CEy1ndHbX2etq?Qm9_d;SvC6~g!^11TjSuoN`TRq8^`AdJW zBdhU#0yiXU=(-`HUOT~%x~AeS-)csB3-fxC5{+oRS#K$)jyc8oRK~SJOe!Lp8wTiL z)dfo(F!OeHhCA~DEymZnGi}h;*Q4|qn;Y8A7!K-<4p?Z6hWDEoMYVFzYt@DfOqGNS zUXa_w(+70Sz4?-cKirfoA;04iPO?@k;pk;YS9rTSs_pooLp`SAjGo}yjs9k<$cc#V z8`*T@8!NiJY*NUzpoNb$ts^V27Zs&Z-9F)nXO&7M-p~BTsR}MSjaD(@gEYgfnAE!j z&);TAT6>|)j^5JT%{JIM6>cO1ylnFRv=sO6?CxF4mvvQvy-oh!sEB@4?z5Q{G`Un= zlTi<3ek4TK+clSZ zaB%{knkYO|UE|C!+8YRX(VN%mE1Jr&iXM+|R{945;Npry7+~@<@91Z2J@*k9>hVq_ zrCpn%bpQ9A0k{1(;PkC@$&aT1U#**C|fo4kbjCd31keSJU{5-)-P)bjXPfolceiR`5S6#TqQ{crYcv&&vr z-K#(k(0=usKmE0oULF4*p!%=5wDjN1^JaqWuF}yHK4T_mUgoE{Ex*n;lYu*rvw#~Q zav%+i83s`1Kg!vA z%Y^{=nhk0~*j2uIIcZXMdd$WF<-9$Vxy)Bml^r1a&a^1)Ukp^oT{+PwcHiMM6ZOhW z@d2yy*&dt6Z)}e^`a6Cmu6g(9A?2L`1lW^qyWH0ODt?WPzS8x$i+<>-O%2){WL_Q( zI3B0UjqQ9pO~GC0TSgQ2|u83lN+#Phb%MJo{*TNZiL+Ck9M&2Y)Ss%pv(<4OF*4C+m)dP~pS-HNY!5DnXA)Ojg-_q{TQKHy-B9-3Ei ziu|EziOuR7d^1FBPUj}fzx+Je*D1=J3*$F>bqfVVBe?w_?@KgdIgY}Pl$&n$OM=;` z#qN5zpFL(MIg~^Bb?pWfe|NbZz*7fx^?}0)$wOrePd>Ngabh1IpVB{cem6;3=KFNi z!HXG}{{{d(n^^nYmMQpt<^6w!`16K2$et1*zyAm86=>re3BaD9%!}3}N(6$nvSsA~ z$^73(;qUbQKa}rDFH`=TqHP~`t<^aJ1<>lw+IPUq2hFL!WrdyFjFmw5K8Ifh?fe&z z-KYD!^KySmyyC+`GqZ7Gn%$*6RG(Au$R>L7S;;VEY))kQ`AwB- z`!V)#YH^0Ne~7_{kB%QsmZ^CLD8SP2u3DY{qMk1Pb9D1u zNa;iJ#(xF1fbJem8w3)?mEpn2e7s%j3v?mIkWlK8X?OFLg=zG-`d`(Au6u}qlpBFp zv^VONuNL@;dY@R?euwEhh@eF*#z*ni72Se7@ViL7aMDD2&*6f?(|IyAeP6GS6A!Zi$Ch?xMnmaJG3TTg3>!&l z6LGD=CJo1Zk_x%F-ATlsl2Do%Rw6)p;V& zWLM+cgWx;JIeGY+*n0%30pzi*=G!DR^u~FIlqOFIJH)I} zLJg%*qze}GG~RX#_u(IsjBeaSY5o+hbW3%~w`#PBPMSqs54)|+TER$S+T^t>RK@Rj zp`!PojUi+M8>&I>9l-*H$BBx>i&7HY$73;Zri6OVyn(7mM>=VJnV`M8f@UBJ-Hs?h`^TY>?H zWv^`HwdrH#o};_8_eubh|15h|@F8ACX)f%jVufqN63tjVJ2g?56J0(rn&%+EtI z3cM2NO&j~R*gZ^wS-k&?#kL`CLZ>{%v4kB*G=NP9oiM-l#z-u=d@pdyN}_V3g|z^? z1n@6Y^H%}&o=v|DSfJhJ&$0&>qlbZv$IagOSt;3k?{2I>Dd5&;mixwYT9+1{4kfsc zu7L-biE4KrA+7@l{_frtZju*z{+0EB%LM�o=)$1E#C1l~G?jbIo7FKG~gfxcaOF zrBT=f?|T3;O+vgj61NBAqo>BOjwQ}aH?3P2x^>SA5UQ$z9qGJ)O~xcQWV!R%rqg`7 zrFgV#bKvh%n=X5=k*+#mv>)#nHFzBOnB-{o>bb9)L4Cm7jU(*%KzXnDViJj9VAk}M zq+~{F3yP^d>Wqnzt`yihhMrn(yyWD#dKEsyz&?!EFcZk;#R4H$q=%!#@S;(@Xv*B( z(+_rcbzoaP zFTidvsNz>H``GgB3HX=FDT_sY`D~t4(yAWX+z6au-4%5hjX5S7A0Nqh>yi2(U;+1M;hF?8{%%jx?a6x@`{a>nt9kP)E*ghgx&eFA5 zm>`FX&DzkKz=pSWDJ`w*qb++YHHLy>3kZ3%u=(4t&m+Y$cN2xUHxK3+3htpQY_gHP zkyF2g>ddkXB4b(lYa7zUbTG_h%#+vdtA{=^GI(hQvf3ABh=REL58~Dnx<*fBK9!Je zEApTHY5fEFLXgP~n0eq~DysoK+p1Yw8<`k=v36^>OYY5cb{PKiDcpqi0Zo>_sn{o&ZKoZ%jJCo2y{FwA}0>UmOd_O9-X6w^yt5FigO83->A_9A|FK;0uC z19Ukj!%i+x1yk_|edkDbRUAgH?Py3(Dyh)IfH9Ry@Hn245VIW}SWJqCD#+n75+J|V z=Q9jp!aXxEk4RUTah}T`=4st4is-&Z!Q-|$m%-sU#Wf&-`}UWC)^WahE-oit$EP#I z#6g`Nm%`VXK^+{wE3d&N;_M6x)G*{|pUV*9>r5zDyN|CmAyl8R`)~|S5=6gCL@cx} z^W?|^C_Rr7^V%h{%T|$ixUt(^{QQ%`x#d2R2N>RJwqj5MoVo9PX^0EL7|NE~b;7uMEUZSMx=bXyBY80G?k? zLkmF{HO@*l!hjRbpcAT14ZyMFy|yNj9p-iiYQ(_0j8SWAedx#&cC0#@U_+sgpqYfu zDVXnPkEA?~bK@XBu(W)JQeo~mvR#K>WjQucR@ZUmaDgEZ_=H3h5e;Tc zEAEjxy}mgve>wZ+(fs&5n--f>dHg+9a0rwwhHy~~s8`GQ(6^?K_wx+h7>v5oJH9{^ z6=*{GZh#5;I=oCG+}HUft+j8e$EC&t!H(E4_Q)ktN61d9vP`ER_|h)OkSYZnv%18h zJW3<;j*Miy;B?jayw$JJitOoS8iLiLM^|do#xefWp`F&!AhX6#=eg zMwC_Yq476r4A3eoi?0JvN;BV=qq*ISTNgOf-{Li91PAhn&#JChLi}dxtJ1iJT~eMr z=B2zvPM{uH+t0$+OLCb>?^=Ir<0V$m}V&*KvXb00r(nP;w8#L2c z4xcraxCi74N_6uq7c@prxc0Uk`TuzO_CTio|Nkkak|>qZT#{Qi-W9oDBO$q#h)EI> zYwmNIdy-5d%XRMeh;kq6YBBdqid<@Du^86eX8c}9pYQL_NpsHYye`k@<914OH5nrD zk5L)2y+;g$Dc-Mq9cSe$Pr9;S|JTJZ!UdJI<$e3!nV!Z4w*H9Au4A<{=E4gftzesQ z_H3cFdS~8E0PxoB$z-Iixgzp=-;TZ!jP}4&>Ti$DF8+L0NEXRj*6|jMX5oXz?zqg} z)%>v+ovW`>1}QaBW1)>daLJSVeSKbZ^6LuhqOAD5pWQ2g6h37!J-&O2Zp4Ja1i_gI zGkQ51d<^ysz}MP(J!??=n7mgQ>Upk!lde8X46KUagEJ8Np`C2*56;p8P|e65onH0Y z)*||NZR8A+UM-T24kPF)?nVwDHOYFrz01rImlT8zbnlw!ym}9zsg;68$7fk0M#iB9a#zSu=nT*_~_$e2OcRI)d`yopZoBKipHR@8QX$J7*c z9y&9`euN@k1Ypkc$EJH`Q`9=qvl ziD-^H!|N%X5M2G1eZ>@u^!Yi9;Ajl7=bv)pNDFKJ@|2Yio$zJ5&#Wx5kLH^Ve>ZtN zi#96l#=4Xm3$zwKasI9a%8hrB+NRqS`$WgDBq28PCP$u*phFJh#=o~yi-f!y98Zzz zw0`>ecm4Der5MjSWQU1IKEBFZ*0BD7M^0()WZ>?W z{qpvqM+_*MKU+CqnD=8-sI8nDhZMFTUd~x%?$XENKO=q1-VPWT$@uQ3dgjEpJfKZe zLYmes?6J+94A>r8nd@GEBCtC0Qwe-ib~z^0XztkNSDSTZhXx1J&!o`SgrWLMw$zYU zFjD8#{>Hy@X!Yle-22!(NxTb|I*S7)uLIWYAtj2dY6IgQ81-8+4+%_DpuaeFs=sy+ zUSz1IwxTOY{|3b<5$R zg!JYP(}QWJM>Ljs#^#vl1*>%{FBYn3F??glaac9`YYTi7E}uFS%<>LUQqH%X8RR7@OU|hG-mQY=$nem$4eSeeC3yw ziZB-A0a;{D(eFUC=HC~AX@B3;XHXgr!H@Y{KWwsKc)3*;VkvLkGDg3OfP$A zW*eq2Q5R+KsE-mM<4c*r+ojW9y-58^Wb=D&PBly6{YtRYAGzg2m&yiq9!y}a`Sx`m zTJ#T`Q6g;Q1l7ZFgr_w7pxDuTBFIso8I`9{odn@S`0fRU%fpP6$@%~#()+$KA(3M% z3tI1;QyI@RS0a{4MM~ZX+yc+R=Idg{pV|CB7f)|~Okk8)*N?Roj#^x%eW55fg;UII zS|}vD%^NnG&j@0(n2Zs3<>(zCJJQwfh=b3tdz>^Q`NL`Z+^wy*>b6sYx}R&z}ZD@AUoMEiDNt)|!~S768_GI^u<7goKlPtjCp2 zb8oZ{S9Gv$bet70+ib}y&YtC^4*ANM9kG4ZL9pwJl>Mk&EFO&@I*)j2Gmpo3j9I7x z`fJ{yp+e}iuX(Ef2j%WPi{kIz(ajODvqFicd%ux0dpr>SZJ zzi_1kX}LjTuqoro(NPt$9aga<0+fjnU40pY^vQBjpxuQOl`1{Cz%mlXU%s4r^6;nr z_J}(Q_MoQ?*bd>T;#t?&>0b8n&((q7jT@YAptmcHqV@}oww z=)_w*IF`p!-GV>s{+Pjin~9}aMQ@v_LwSN{Si@7Uq-;kFKA- zskOk#obb}QVIjEeA<&jDql=iob|{8s#V{!<^lmTCi~ePvqRKaRp?K+Kl<%tME!ifL zdox0ru@sUeHgqwRj**Hrkw3PVwUB+MDN6+Qgog#;YEjw{x(YMb@jc$u%Lkc6fcX4i zEt{@`$~g*fWk?No>dwF|04{*~;oL_s1tdyt(#*MGrVuy?Yww+gWcdJt6qg`0?mG<2 z2Clz@jy^97)Nh)I!oHg+ff?Sii_Dqhk^p4~fUbp8A^f;F1}aGOQhYVt9`8)Ec3c;N z20Hq;B#;zn7H0w&`otD0Q?D2DfBFf#q21;wKR2Rau+QL|gd$q_&mZKO0g%BL9=@$x zfk6#8Os@APB>n-963p3c`vIT67zJUe#!5Igz)-}GC_s>{RQ!D>urznr4uWoB%l}fH zjRD}Fy8fZk3t#wOd01uY8fIe}hd0jcGs=l4TNPz<#~Y@RWo~{o?eCzjPOYhoB+x6o z_neRbH)sx&8ZhmsUN^uMo9&@w@A^OxO6|=BwiFaVtT8!|G<&%4w&3pFX~%%3D8J{B z!$Z3^B5&W#c&7_Cp&`)?8>hTgT-dnZJMIdJDx7eXlP@#hGEgS(7?kdC1|k@A_WOJw zNX$+Iz*N*WsYk`vjz2GcHM3VdAHq&x4|g$RQ{X@c^Y_XLFhh6ennNn0u)zNf;t3#@ z*b+9vcAa|yhNL=23P>Hb9l`&dKk5rW(}~lnmmwhq3VP`;(UX61}l;Kf$ z_p5HZN{e5k-WfGbji*UBEGmdEDaM^9v3&>T5;T8g+FonxinaO?z%4H(Nc(0!)19~& z$$n_(@Nwa1I+{JGijy%8;oL=FEYIR7pB8EpB(pv&=rTj3-D*CKBPUkYjj)1Or`0aU zq18$$+cp2rsqF4wL$ly9&(Te)OfHE)PrTI*)w)FTa!cF7uc8iC3YK;R=j9T6OR8m+ zkoDxmb34q>I(YZ%N&8o+&hulG<@X}QUW$5upiHk_`XeU5?=k{ z=kK9d$w=0a9|<;~)!8Tc{o0LfWsXiYimcI^cU!KmCaLU`z^2fr+#=-YQW!6zXg7{Z z^{B(Ll;>vVBdZ7SXTxDF#YTm{T$=I;)=sB18`McBo-g695Pjp}?B7!?`Wvx#`Ic~B zrU}OrOt#q{HT`$lh?GTmCPg2GHFhf8D2W@mW&VvY^%mo)Gcr=Eme@g6G{jygRl(9& z3et`h*6waa&G+OSKFRNz`Al|etg>%z7|Yn%cA^Va--U8KSd+V$S!5N<^8oB^QynJ27`foDfqQgjK>+i=Gl7Xxyj zrwSZ+atgMmAF%J6_U(da28HRJl=sXmxEO})0H;Ms30YFl^)li0EOjMwc1@ zAL22n=fn8YfY%r-s})|*D%pHx9^TF%CKbL7J^f=@l%TyGqEry4+JS^;nO$(SvEjjL zNCbADbb>D0Hw$07sxvKt#L}n!7*w#Y;9T6o{~kLijCbNJXfA8zwT|!mv-ZlO@6}l^ zv`z9j^J$|8{tCGgui^`Lx#5B!b_F*J4N3!s;_|O{xamVYHAuuc$*=Wu2lb7erx@90 zN5>N{ICrW|C6mYBb+#tjgR#JoB8d9;eao-o+g7hl!@Ng5ZLO;FL=b0od4H#dn7TTn zI^t64LFy*Goz$_(TXImV2;=_nG6DGT^nfVrLp^r)haJnez;+H9SKC)YG=cCjXd5-HC9@AY4Wq2UDmU@z?u3Rtl5{8Rsyf4=wKMM>Fs<4|a&$ zrNF4-T;EZ^9f@Y|o-9XvA%(1-Zw>J&ARi0o3d4hK>a~vGbs(vmDJq*CpTcyg)Wv;2 zBR?OgDx7(yoJ&6FNox#!%-Rt5WGLyL@UdonY@Z7_y0Vj!ea5w14^8a! zAKMFCVQ|htj@2GLKu6(yN>-5Jep-bEzrHqEoSv@4o1YpZJR&z~O|ckHsVl7`gmo(I zuT}7ZVTD7eto-Ij4Yq6ol>~dB+%3G1d9lDUCW{nDFr`$Z{Df!*= zH0c(Jyq2?jOsr`Y)!a?v>(%-yWw~%R>s#DdEUMXfoVr+MisG2mJzU+5wv(UhW>e*f zQ)>+0UmIGb#!^??GO27ioQPI(y|6i_ z-B=#F3^o>dGUM5XQmgV;v5tk$2)oTHp1W*cxWmR{oYrv`%b;PsBM$EWz>Q zleY3l0i)hMA1*Mwwv%*L#w!?qO!8G4*&67Hn$z>7sY8fKzpS7*G7w{5{W8ALMOW6G zS0}MVR9c=-5H!^vvsLQCaaxO^z`#Lc_9u8ZGj~2*?L7>~z3_(X_H~cK8MvXGb%f!q zNz~|?{dcWut+^?|nBVW+orBOCm0t_aBm_}Jv7v-W%6JxScD(6))|1ndzG&+cr0z#D z7O35(SFSj~E%8sf(@o)datFpk9*@}E?54Wk^Cr0D{$=l6_NT_!rBK2owH$iMf}PaZ z-B{c_e}E5$kF-&Z(b+-D0(jpsDr#&|ibT5SO%yvbvHo1<;RAx!pt#0@@KBJq_>gZ;?9I;7!q%Axh>_|{hC3eb}?gQJ}>S&ECwhXIx$L{pAn7JgSHjZjys?Z)ud zU%h`wupQ=%4U-CpG8=6RC<+4@$uF%nm4{PqyM^XY*4*IpoG~*%~ev7)g{_-vRH6fuzGlSecmcyhpMKD9x#uo#+DAdrz z?wGTY$}Ksl=9uxHf%5w(fnpn}%)kvNIpU^w#U^Qc{n&+(e0%hGAoD*gk}t*Yme*>p zpmNLl;bkUy$l+ol&*ZtV!Szho%%1^9qDyNPZkIAs8 z-m4~P#L-F|PfIr{$hyS(BuDe(>|FVCQizOv=v{T3|9q@NzSgHIM-Z*D&Yd?JN}-;h zz#XQ^3zf^C+mB#@S~BFRq9)iRx3jm{Hi*BZ;mB`Q5L>cocDXT@_}FHIf8 zT6k7HHvyKTHDD!&p)5z=gufDFRerZ-sIlSazb^Tyg2th1x)c2i@gR(@b= zfKVOdy2lxzdA=D=ij;`D{0Y(}>OYbuT?c+|A1vU-<{@z`Y~p4PGp6U|-6?8SMB0uo zkEg6@rCW~16}jNbL2@@C%4h;Uhu)Srkm3|1n?(hmrC?d_d{H+BFtZy{d!1 zq<6Tpgp6$By@*Z+0s=^p3u<`dm!^$(4=U_C^>vl6dmoS@wa|XgALXuJL7~V^D60f(-+?2NH(E zVEgYhho08{1lk`naa%;C>W(j$dYFH=Y0EmoC%3VBz}W8Tk@DX$;xMk=6n92A6SO-A z&&>d(IHWNL0`>t*-<@V1u8IE}cAE+H=|8Rt05*NHYbtYlm;j{bfISiQg}&)CkWGg@ z&Kr(`#3@!l(BhT50ZJH{(c#YWpTFlfcwrMKAzLh84|H@cvRmxU4L*Xi%~970)F?UH zBoKu15KKdD@ht%ZEbU5sHSfGmaqq-w0#&W=bw-9f+eY)`J zJ;_e0rMjn<#JJc&&1-OeuW(4d1k*Op<MvBYw!lZNnzp#TxG#6XFwXA z>?jot1{aMQa}2n9Bmb1sUK|8+lXfq>jK!x=2N<=SR;jE3OjP19BM@1m*;b{MiX#c8 z((8P_Rdk|X`V-|jVMM|_}RGSkwny2~69svrj} zqP*wNhH3Zg2R*AgPz(ayjH{g;DCVANfhj5eyf_c2JjA&JHnMr|lrpbWZFp*1I<3}N z{$lo97JS0oMQGZSTkO@@fg`i3%H{s|=2S7&S^P$VN#E)IgVmLcmmwjIV+!fi8a_B% z)!pEb@CyZ;M=Q_3cju<#T9w$w({n^yfa0W@a&{_ICVFgsWOa~ZZnj6h{jhd!Ova<4 zsOW?g;%&5(Nrye#$;XndS4}7@y9W|MC1_%*VejkjLDdX{Jq8u!hWx*V*Cv5< zsTa(eY;A?+Yv5*J&%{7;_McB0l=A}v=7&98Pa4YcG<5|93o`OjLhs{x(CFr@1zVmL z&IWdmZQ3Y{%!t!(d-DA3#*_vb^oxB==bD-`Vsl911U8brb_W!N=16Fjzb!>T)2ap) zIvl^+_h1fV;Cf&6(R1w+l9wkj^HO^$;xL>mCkAMo-3D%fho3A?=WK%k1(n=Hi!f|8 z4}_!aDtg^5zr*YowDiMr4f+j1@@tk|IrzBiq-xWTk)<000mGs&?cG}Wfy1$@)~W_|1B9PJOf%XV0_NlJ_kZ3VCe>09zPIt zaxzCUp*Zg|SUm5xD_o`oJQ-HE%44?DD*n!{oeNzIbKSE>2$y(CWpIfo7)K&fvtGj(1kVJ^uT(~{kgl=qq&x2vkKVeF9d>ZO1B*CcQ5+F zK!2W}svF=<21aW}K3e#p$9GotB!fT_>69u&73iXlVK+=cUuY+Js!C>qA0o~*KbzliZ=R9SjfdV9XOW+6d0&y$nVUHF5 zP4>#I$qokov9hf%jD&h37^|En3du+gLR%RhP*2qNDg$^!+L0&+$e^*e{a1greFxA` zwlFjqu2lxrjgBo6l%{amHYtJqC9kpY+yF<8S+tB>n5pY%irsa1eB^o>kJJz|rb5K( zCi^V!@H&0y^r5dXJ>hs$?h$+^`n)G8@+;cBkId8PUevbKEY-d)@+{L=^Mr8r$+ou^Ewm#nE7pb`XPhMq*#woM7y(oi+I5onTwiB@PWV zH%!3KlR?`CYk_8-#BPcJ4B)0;4hcgFFPOS60HOrSi|vLc2SXx`12YX6wwW^MpR^Bw z@q~%{{HYM)ncp%78A7VM_fLj>jWBuPX$?>5A#sPGwF>l^YB`|y1YPC)UK8Yetp

  • *TbFsAl(@s~jJP5$n!bX7r7UMVbBhpTTm-n;^X)h_gcjDcHr_w`IlI zk&S`?9_rP572Xdh`wf)8GbagKy~}B6F+#) z+#E0m+j-brIihLZd%-e?X}8l4^D|!$nAjY26~Pz4WTgiZz(R`tmyiV6a$veJ&_R7z zYJwz^0YHHWQjA2lT4cTL(0xs)718`-4$Y;TL;AKbZ8I5w5eLLb%Yd)h5(7%aUNeW# zMhK$Yk$bEVh{nVfu5_!v%RhebfrP*wpYoZ#USJg`=S=|!4Yma+!WMN!-U3-=*NA$y z@=8dSLM9c-7Vz|AoK|R39V*;HwgR3G133=N1+q3xfgU;0PztTAe@xRnGeZ8#NP%kf z^UJgZ{zCk)GU=xHX!PMsp^go?i*FxzI*ueMp^G2UncE>ClKa#QCA&D+6FOSY|C5bM z2^WH`5fbG_?K|tftCm=`pv?yUt)8vP5xWx@0n>`Lz~i470p1PqnZm7H3Ny&HWbTqq z6=Z!Fe)arFlCmDTGSkq?OccxR{RJNK6ZN+3A7bUM0{AX^PPNUR)2}{Lmvm1q;i+?l zlFD4gC_Sr#K&UCOOU=t%N-M*>caTzN2ti}4AN2?TB(l4FK{Zmp#p6P#qqg>z{@AAX z4-^BG-x~~;t4;3}NUF4M8=!r?XTuu7ys$SSXX~0eO-#!qdaOiXJWMY_*pKTN5^lV&#~EZ zy>mM(H>TppeL4Ar5<~8HN4NH^KNV%%VOOB1qfTN7Xwk9&#J)S$%BVfuYqgt-9Hdg z`~=!G_Up)$bcIDb!}XFV00@(~Oi9{!dy8uP<~Bb?+ze~0R$la*nUrGTIKqGG0lPT6 z1WZ;VqaNnLo?2YQtN`Th;(~=a=|OXt5Cv7vfTa<>^e?SXK)kf%2B^h?w*zoG?=ZB+ zU}mR!Py!++7QSQ$a?4`s=M-=HJixLHc#;eniF?wiRpM`CMZO_#|D-EF9$pzde^9X0 z3KHTv{?-G6Skw8YBVg|7g5qiZtd%9Gg8!+}x0#P#1t+rTV{k^z^JU2A?gh6dU>G%$ z1KWbVegDvJRxKHg*y(-|Ild~59bglQ?VJK##vx)B+*q7vbz5v^sxOV=@ zxloguVQ$#L+~K>J5fO@qXf5Yz-fh)w#H}J;wFsmQ{;QgxghQyX5Kjhw<+Tnkh$o!i zp$MenFzqc<9T4kJWu5^nojy$CZ#B3N*u<^hUoR2difp?HgcmZM29OlwqH8czRKg}I zq0Ao0=phK1Kh46|+~M67-AH!TMe_E>mZ5znao&W2<3So^&i7(`7wTT75*ki3yfDX} zJ-%>Lkt1|^=Kh=Yl5y1$Ohp!Y70g~~nu_x*GA!lIwUfC}G}k_bXs_!ig?)?eW2eC* zg+=Rzs9#Z31%YYc!^8<|5KfoikVMJysMR{>FCyP7;AKtxfKzyK_-xs79VbcM6A4H6 zcU|pF^7C5q_6)&{@C}X*;*XKb#J)Ve5A?b&h;lgJnTJ6tmAF%9$w5M2J$s6^cJy~g z-4y3U?Z})$1(8{H*FnQH0_AJwycD?K}5Y>x& zZ9P0$Gc#gRI1TKZuU}_{f-4mefL6A=AM+dVE`Zt}s8hYLtc4?_{V41uMF-|WI*V`~ zoH>w#0;pMaLB1o*4jdQYuSyS|40sag4jq5Hj)8yPqeq8Q6#hl`@%)G19<{%-!W?Qt zs>sUws>havfE}_~4O-I2DLx1!ac)^BM9~}lQj4Q~4GNr$+&WQUVZXqN4dW9&Y6*y- zoQq(^%wtE`f|p#ulxcr4>}vxS5HL3br-yJl=m`K zWie+mwREkz9LL;QV*5*Iv$E^$nAa$rHE_ZIL1gR0khHPe2+z9BsfQ8@I_-y4hPB2V zMU5%&grr5|e%V8GdIzg3le}PclDul*o4bz1e!Q%edo#~4+^@>uWn4^#1{t<{Vn*t8?xnd6Bi`(W{Z&X|7gzHD9eOGI&M z?O4mhq0JrCR2=_62i57q4fjU-pic9U(nQ&1n}T~5UCdy8+x?Vp#%n~Y;mi|c4@41G z4A;r({@U$M;SAS`tY(}SMRs98lxNaNCW|spSjs>jsjNhHS&|mSg~}OP0(>eYa?PRe z$(*zq_M-53sJc62#zozO|B2w)Zp}@h%o1lr%gQdSJ)vvYwk_ym3UauEbp=lRZLh`09uHgK?AU62f$B^Qc#;$#@VS3Vpk2ob$w;iBh>tsdHMfQ zs_0yZb=+bLAq%KV!|1gGZBhmV!kH(-Y;B+>+8Cd|U|N9AKY;Vq_~^0ILwT z7lbct`|=3#+<@{DEG+GCS3?kyBpx9P>ZY*gVZgd!^$Pev#I3d}Y9qKu{pWPQ`$<5H z2JPhF+vLnmfOQKpQQKvULTB7RuTFz@K6EOm>pJ~{wt#;XaL@60WxpQfS}PoHGSurx zU=Ks$EQu&pXrEZQ2yHgc!3j07&tw2>1V_zGG)PGUQ(WjRdOJ1{x_qeO705lYC5ac< z4LPSja;T7<2wcs?9$!#Xz@qqoZ#j|xIf1VOqtHg&;gT7pw*5o&ZLs81TYt8q{swra z`U!#HL3lBZhi&eDEIn3hAiA zh5rw!!sLFgXFpFIQkE^Ij}{B<=ufoYJkAl__CDL~94G>%O23|$7X!|ufu753!HdQ= zYwOu_nl)M$%SDb&8`Af~mv~wL-~%8)$kGIMf*qi`eJnXs2D*)1ToB5mpaTh4V4(&e zwFCnCB%@ssp|ZMA%)vjraTk<(8nL_65bRw~j=ZXXe*K>~;#u}r5Hkuy1K`kX29id= z`C*_FP1d&YI#j-tf}>8{_1TtfV%H78m4UQoCfGLG?Ayxe{tuQ4@!xlw4x>hq4i?C9kbuMGJTuaW`9FtE-!An``;76&>>B1H(q(vST{(0Pz2S0o&3rfPNR`qi&h< zW%cHp)WCITgX=bnx-1DD>jJ)oC;_*iJ@=nBy6z~X@Y{YJwC6~uG2#nS_llfyvd``i-Nu2+rgK|A;x`CTCDa2%r_-4BKe< zJIDYmcS|0;2D&$}7;Zy-1T5>q)FJL&D&PTDyS{{Eu&;G$K>4~A(z+uv8$3HfH_+0{ zo?5~1!=!eBhc0Uf@(&{WAQ=a4!~{4}%^mH-t8SZHDX78G$|A>%{8KeJUdF`A@T z%_X!IF3%v{vE_KRvgFC-DT%uiU)ylBTjvb}zU)OXQ0 zaTEtzQp1=ub|{&-g#6Tisn$Pb9_V-$=dckqL{xl9C;q^Z`M_D8?S1}`n7j1sm0(@b zZaj5ieO0W4N4N6qPxUdv%aPE{P1Jh-sp-(L$)KXi?=j?V26>i{k6N82H()+C!^hX3 zQIaaXnuV0SH<3R+Qi*#fHXOcxVIfq~C=`D(#l0;d=;fqZQyRq3H-@`i(#G&AvN?xm#YZtpYh%ttx6*)z1Tene6Z#VShFNUtn%t4pvln71CnE& zWq-QQEe70eIc!^1@@J%&_-WY7TjPXW2~AmhCO)wqu`!kxOWF2)EWrNii&-QsmfN*T zufde3GtRiFQ3YR7JsLckVZaZJ-0E4t`@vaJTn}(D+!PXfUsd#Ab3$HOGx6DM%cSeN zy^PTYAJLc-Q^66!skN>3R*&Mb6wF)-X3Y@6JEJU(H}<`fP9#%17gaHCCrEOAV_gXi znI6?z2$8mt(Hb#aO<+HzCRgVGep85cnwi-9R~UQxlrrKZE6}JsF*trXydTKmFn-I% zaG~}k!8;b76Dxl=QDc1Ll$C)vxWmo&s|h&uEY+737iZRwmcJ*MoxPEZ7)*nD7kM>S z-~Z2KK-njrjgRK?G)$IOgcw7E_EL=WyaA3g(sGhY80;HAa*`;4FKT748yf><^wGM_ zlwi!o^~51!l@Jc!_=4PqXHtTZH3Rhag;;08#==>+KPPDsE~Nk-9&>d>!k?4QYcsqdiF==(t14^9H0Oxy+k41C>Ja>jr% zOuHA|ICD@p`q8Nwf2y3K2(JG1SogcL_dQOMmlaf1SL`IVfn5al@XR=~yChAy6{vDv zei|lN{+gAM-s3JVnUUqdpYiV+cVmN#;gs3oOYJ`gs%HrjILNm9sX1L{D>yCWj6>{65 z)2^0)6kIx^-_A|=Br zw?Hx4LyTP2LYyiWaT+6jpW0c1^OU<)F_KM@+~+l5a-^@4h;VvQkVR#7oTLYw2^kF*!-4Z*$485Y1QjMK6OV!j8_6W)4%X`sd0rJfQn1)$47^vxx(bZ zGYh-Y?mMam)6>vq!!C2f`o*4aHv=H>r+PWKNZD&)aBU_&&7Uud+{?x%fs>ZeqhV9}QTq@|#Ob zF*DxcmHrA;q)hNiEO%sy46VVeu6+7M z@8an9(>LkMlHTYxp|09EW5R>CWg8i}4U^?#vK0nOY_%%>Opq#_KJ|cIl2ZLcKFd>y zfov>$(-6FR7GBwu;)ML}iHLuL5gKxKFg?)ScfJz0`lOs`e6hrT76Z)4)o!8F(pV>u z3w{RYX0?RLtPa9w18rEGe#`hJFA=c=PEt{VVC#Eq&Kl=jSkK!m&czz{EEAJ z=GDzol|kZ(dhhMaqy3xlpFr*N?#Uz2Tf9@*LKR9tc*Wyi;M9LP*{J2(#pV-93JJ+s z&jJs5W^QJ=)@H2RS?%;n{gtlqXpa^Hn}kcfs_k}+8{P;X!!!O~o3H93>hfYQ(%Eis z1L+R3Oshx@as-L&wC7NNXbs-*PG--WXTCXhweOQ8X?JxdoKZD~58L@WwGPKTTF&fK z%`8gU>7I&HQ_pbv>y%+?KwjPL1ov-aYo@1AE`DYHP8+~?)B9&-QJv58VNu<{}#NjhIC7pGBq)W))4qSzF9 zHe{2~X!^L69uwJuCx|pLOlm2@_-is%n94JXpD`hEryQGGw1&`UOlHUn>U7^?L{3X% z)7tUo?ow1n<+q~@eCeEv^Ri~9BN{=;e%&HB`%R?CC$JgaGE}hrozjQ%bBaCsJfN2h zo>=lfnRWmO_t>Hrap$_^ZzKW+X+kP(E1&wyR=nMgZ1j`0cbEJ} zPFUF1`zm0%F*nKqgcmnuD#67J!sxhe19uu}zkY~sLZtViOh^?ww))lT-rpP$Iu%EB@f;|8C^;!YXuWYwR_GaCT3?lMx&$hPh zdj$W6M1}RXY1WOKcv};Vv8)%XwA^ij*C$JXo_@b}Ka?jDCShO?+6HY=*SFwE5S+ULR+Eoi(K^wdCr4T80EMS+U*+JGq}C6D51)tOMc51{s6dJFY$0?)2@ zo^U87;w=qKJhlnA4VZ#1MH!+u08S7Intk1bGzgW2gd^_&AqQ}N*t^qEUzV9d^DCMJ zL)=~I_=UH#$7%!1obqJkEjmU z6`ljk5nup85e*9lml>A*9kdyMOb{+dJ#cx0DK1dI09wYX-9swT`=OR`>pAF#UjqQZ zU0r*R6#l#pvUL|r{wRzAD*M}!mr0p}?wKxZ%JWqZpyNP5Esyx8En$I?El6@x(9BVd z&eit*VpsTda1WyhXUeBGOVsN+@mk^)kfQ5{Ls({*K+a&$kHN}$8GbWqD5nl)7Ka4{ zn)c-*JTJr{#ksV?75^K^dLkMYwVyQv_9+2pFx)Fo8@G_quny=s0H_A2avLJk)U$6N z;aQb^K#b|v!;gp=eIGLIQQr3j(Txf{Hl~OhF=U_TSN16HZsDxo$D$F-S)MNWh@0Cl zt9=Cg+v#}@?qbN#ijB#ejv}hFE;{0)!TsaAxt51M-&;KxOFA^%as&EZXx%Io7(c-XX|u9@<`Sr&vjA`@+KfKFC_kPyO{Y6`^`VSm**S<{2c+ ze|ySP&eTM;;Z{zk377mKoa1fD~ zZ0^Yhh{R13L(zhWLN|!*NZ#T56#~G_EQ%AR%CpGbp_Le(s4ozj#u>W6q_c%sy(&us z$`_NUt;_e*>CcJ_&oLLD*_oPZsC!nX8q9W-`&ozT=e-FGQ51j8^Ap=ZDn#?y<*!2sm{)wNT2A>O>06+J4=py%mi*TM$h6 z1XR(1*7Cnr^wrLv#nG4CB>nGZ(vn+SO=f9vkRQF`ugs{~vDliFHE%_%z0^`I0Dc>u zQZjt5p{Fn&S=O~^;qDkLc+G)^?)J0P994thjkO(HuSM`%KFR|#1Kr`g{mpJ`7;O0| zMe6n=w#Pw$lV?xru~yDymIFb})A1^RXK@1tx17jt>9D8JA)UD&wk|LbEZ2$_haqx3 zL8{3?5EwbR8=7kKd}m7`Sn?v6PzN6$1}_BxYeTLlBWl6Hfus}NWr?(tKYCcfj#m5| zbF`K9x|UuBm%+XsY(;QLv#83oP`S`w)a zANT9N?AAv6pUm{8YY53qUl~iF{+-xNCrhV5 z@nZ&%P2i6`3?%?T%{BxCNr2`dA3n*?0 z*htJ@07MFk^oNDL3Z{kUMK>0qVJnh=8r#YJayPf!5aH=`prByO6u>vLcLC*KZ?1`E zo!0p&BoFujkgn{%OcMpsnGPzMLRzPO696xj%{|#zX*6&RAqCe9470 z(py{=c-r$&mPN!G(8kRlVhw`brDxLj^7;6qXEkzP`^C7c&|!BW$aV|9gPA3}W`q4S z3b(GBMSe)F<>4!>u`Wh2Yhi@D8$rDCpD-yBMe2&4HO~W0>7CFfa!F@ zE7r__xJdV6T~Hw+?ageNY07z!X`;hxjj+vNv!B1E9 zRbv{QH?q_6o0f17IxoC=m=m6|81?eG`V*1QaBG$?kn^k!dMQk(dmwv`?xT;cwlok{ z8$PUM9;L}LHcNY{;MU(=@?$W4e6rn?FE79S8PNX%UWD_8 zOR*rUn?*U~eBkH?Hqz*icgCY<4e-9@V`^48s*w-#$~w0D+y1z2F1?W*4SdupQl!A| z9zNAFqv4l)QfBs6=kYms*&U;~{y>(4w;i+!cCsov7WCfKhH`kK^M!=pzHYUvh(FzS zLKiTrFm3KFeluztG;=%vVr-^b95b``d>%wZ?NWpuJxupQ{RZE*NR(NWSq%gs!NUFn z`{{?@{{eay=Xw<|kT&Ku(7_A>jDT~CBW-;7D@tIB9wwXjVmrajMXxW(Z;$@aC?rVP zH57N42V`*X11~~y?QI89qre1I3g-NtVqa~})&9uoUF#qgDXND6r+42vbX7t>LhjXk zVI~Fyzl_$4@}X{w`-;->?JXGUVFv&!_mu)^scaM5I%jm&U0t9~Gj(`LFjw*30v z`%N;zO?`ga#rON2;0i?9KbAc8YWlj;}aVj>AH<^ouH-?AIx z!Gt_G+6?AEj&2?Rk^xKZ-5xnzB=O8McP}OTfNq%|gf_x-qd@+x4isMn4rEB-34?`# z4~YgvTPOWN=uqAhv5Mr%e!K<8VSlciOa`uJ@jB-9Mh?c6Q1N>g*^9hhSE>gMw5iePT8>})}x-Qa54qGI-Rm;cyXjj-L$d?y-*?pB$E}Ma$<=MS(FVg zP9}-;#?zqr?^EzTwFH~?l=UjZGEq_O`82V+O9mvzPXb94n;aVmjG@ft)))Byn#prt~be%dWNs+fVl}%j!ZkC{S1uau9FZ?#0A@W>z-6)4>Mpo3Qmuix~XL@ ze}*f;Y_SNQe)1akJ1$#c>&%D)P-lNLhvoqhv0%siCx3u;OdGS)pvez&aIK%&yLd?k zP#)PJi5R?X@NF{N&1f;~gEHqw_Q`XhYjq8kDy$O@YrLlcP#yU&dk~aVQMwiM&=OBx zl4j#(TfpO1P|j879OC<`4{fR-BG(dnHyZLFOIh|0DJIT0YgCuUSP<@_vv$5R0%94f zh%}iUMwh;6A+4&qnATBGKqEZY^8f@*WuuRBeF(d!1mJCWwjU679*6-G^{4v7$LAr= zU<)RPi3<$qK)a?1x9Yw<ZP@*V&h#d(y*5ct4wmZBVAu%!J=`K_X7}=~! zsm@*f_WS+Nd3i1CU-|i3oJIm35vZ2H@K2#{+|+4XUe}~EztkeK*dQ0%YPo1sLZwn+ z2*bbT{d{A|s^dBbxpV=<)Iy^X0=@7i9;gRgUr(8UP|C5lf{PUGo!5t~8=B?)0-HqB z>d;?M2DY`I`~8|PQ`$zBx?Xi7o8q#(tjB+bRF+tawsC)sw$tB>BL4fmTmNnw5i|L8P^(ZuOvEE<>@4s89@Zk zgovskG%A2Q%AZd|**<-=$Y>&@Pqz`yiRs zBmnsk4?b>%0=B-Ke6VZ^Ug`!^&|7DixEZioaU~xR3zZKCsn|ey7rO?g7DT{_gLRAh zpy{BhoFdEv@qeN%xo*j5v_Z^>m&`u24}ma z(w7sJZMw(C?`tN8?=%YPPfDeGJea7@edHuxGH(9sZnftJGRUcTDU-lUTfdt6CsON%OOCy( zYW}!Jr+NL!Qz?^YSSp-uMIrk1{f-XPktfMCl|&UWRsCO$fy~8z$t;5@YN)dKAk5yZ zi<%w~vKEr_s+Wjv`nyE&lFZuf?75WAqTjEs#2=(6TTlY-V3#I2ZGIt)KXhLGOpXW9 zs^@Q`-F2V|`Lfo?jVx&tQ|vUUFVm{bqA)kR2pGdNMD;Guhc}Q<=gP;-K<*d?t|)jU zEzjG|wj1@}L%JW^3^S664^acXswrUM;Y0idS_$q+6^mYRGcAzn6{w-HG}Feh(#zfr zSGp2%xa8>kUwP^B-E0qPqu3$VkTUk#!*aI{yGmS&!!|!o)|{JnV&Vqka_#l=Aoio% zAnn#i)RQ@nJEB!=g!#iJC#Ua2WOfy+z8HnqR8?Z~YKClfr%94dT4cSPa1HLZ^@@sn zK&%L@E}Jo_t8A-k@ds*(J#?+nYgmTEbRbA;bzesR{u?ZiHuk$b*SE<@(srz}xZOfD z>EY1aH%SBB_@*mry8(q6s;|Ga*8gj67&%?qNN487)2^@i?oXuW=PfGF284(<_bc?V#22a{L*`D#GVPNu{#CPaH$`&>2#$e$1MNqVc?B_bP~GkEl8-`-}|1aI=j z*^z|aA1i3VmjLO`XDK~K9s~@+q~wQIH%(?}XpDJI3oD3^`+u(H-UUd&4vwyz=;cGm z-kDK|Qxz5iRr|qnO{;p@zagsG?9;s39&Md%0HRIQVOhcZhIZG!Ia6n+dFzqTTLq)I1Axc+`#Yk8$=ntYyY;S2@c^*kwavfyI;alK#v2C? zi|X;#0F!pWrzDgBEBC{NlgE85-f`MO^y8vS*=Y^>mQabRmomN_&P+pzjla&|iDUM_ zKQ2Ip!F>o*f!IzcJ@r1MtjdOVACR@Sg%kXfpaS2w^8fk1!w%e-Sw{273P8UFlXDEV zf#kXXL&<}b1KL1C0OY!h|0U?&-8%hYiMkjzO-Gu%4Xnhd}KCZC2v>55)`sN)9vt(X5RENa;5rpH@&dT_=BXTIh($ zQwXUT01yb!=1YTIxc|k(?bn%w?iVNs{#{{jpUKACpa}WS2n`_McnZLUaN=(TK>Hh9 zIQeZOMRMD${2%DGz3+^DQb3?#5$(H!Ry*>ex?}L`bIpz*|Vi?%l zw-HW4PUsIHl||F#%i8_e$h+**Qd;EoVjo8hl3;^ zWn{98cf{ZIR;w5vo9#Gau`F%Fz5dKHvXFgOD@$r*`GvY^qSxuzW6Jw&L*OKP2QR{n z+R!HJUn8r9%pkl>N3KRpk!rs2z6omUhFDud+`R!*IgNJQUL8ltlVL8M_LW0U%Ba3F z^h!o+{tk9?N&eg9DNVXottrRJtb0L$Pb2$z7gs8%-%M+9M3*(j@>IUnw$>1Ai=zAy zoIK+rinRH#WkDHdeWm4uWJ0UqN<_2&uAQ!XNp31r@ua_Bcrk1h`S<2k%35AQXjl4- z^~0-}&kGBRa54B7)Cnye*9LX`oK_UYeo<31nOX2&a<+}>6g@z6eXOEI`F~w~1yqz# z*DewwDk+`PUD6E#Qj&s5gGiTjr*xNehcrk@gHl6xNO#8&(gODk{@-{1d)H#kV%|LS z#yR`!{lwL65D)KA;)&tkZVBhbc3aKxwMI`^;dK6$%1QKA^|7#s&McqiwHYNl&FH0v z2A9v;zFi0x@y4x4dO_vwXR{@jrTP>--WuuICKl^O>#sG=I?NCal$prAQ9&~szX?5N z=pN6JS5A<~*5yTZ5$ZN8i3)o7;!Q&rlieiyxTwZY1| zKa@*b5z}PM(brb_9@!qP2Pt38eF)K4c{vww9=rewQ(^R&6j;OovauW?@S1Owe`;BUd$VLtbTM$0-MiQ^^Xmb?pS;@4wX`DYATk}Axw z!>9VrUPI^=@+3wZB7XgON3?~1d}BO5Ri|1I{ZYFDVdZsRLrK(W>{A#kg)?+uLx!E& z6)qm05I~>EvA3)I>kb?TbZDR24Qj#Z!@7F0aS#W>$@|~Bl)dW~RR6JO=$rRQALJ_5 zB@i4Y>FZ;mu7Ne*Xxa{@61JwZb=*x{X46i+m``bDr^0~Y%%>(aSF25;;v%IvZ}+HK zzR^@Czt=!&gzp>0Gk1lk3W8J2$MTam;wXUTfRqM-K0gC>4)6d<%6&d`k4nqm2KwX32Xk`JbqV_KHHK+bdh5<+1D_8J z1x^ZpHyaO2 z;}&zU!KeUq@(v*L0;dfoY+0gR+}>f?zc&Nm;f?^JLdovo4rVEFegVVLD6Hm%2*36Y z?g=@}Z1z2vC)1H6LHtKOU@Zo?X8@uBjFSDmttrGuO7t_U2Lx+B| zHXOc_`Qjqf(kk6wf5$1;(AJ={YqA*bCR19LaNSv1jt+^MqE$H_SB@yUym98(nw0vX zwzxH;zpt}4?5lqyE_z9FK>`~26q9Y@jA#Ee700ZhZW-&|AD#~o zZT6YSrmZ#N@#?l@Rv#R?fDR+&$M}*;!o{QFDc9)Xgx1a2L{VCNZy}yD;E7YH}}L z^gBKAowL*+r`5$NUixI5E4G;`)9JMr7IQ_|pRKVXm4ut|F~949gES+0=Sg0t%HEPX zKzfk=-2BUfQhV>tVoYJWw4@E-94=F7X!y#tegZ8@)6UBF9&rvE9k0YHlYES&MElg<07`%-xT?_tm zGTLjo$)=C zu0gfOpal4t6ykT2OtR&2Q8CazJfOsOR*{ z_6Fn!eMEsSHa7Q!1}J)fc;ylqHt{(Mw_T(Xje*4&6x){Rh8(q^;^hx>DRS#R3tdJ} zQ9dkh-EhOEd(I4?^IoR6%*F455eX{*h;rf~s*xP7wD|t*5k7=?k{Gg>0K& z&`U)UPfh$R@R8|1r6-3XokhLK?5LRZ{PdqEKO^YLJbQo3J(Y22WvlU1bnYqMU*Or?KhA-GW8 z-`;h;BcY&Nn=s`*u7IqVq8#`QGO&RL9QQ(znD5#(gqrpufP9quT&c~LFs;aF)wTXL z%BA2t0p*+dKi7AQ`F_SQ#*(=tAUwihyypZYu0y3L_&VsWGAXUgIGRL8F5uOT4Qxbv zWS$a{Fjux1>mHsoj=pYl9+Sa}8rB_lY_ju=*7H^@xX{b`iq-Vlv-sQonU3ysyjL1W z^_F3C#n=I!tsw1Y@vVbv7lVC6?VyvCvF>8tV#{<&zpx(if10Glg#p6YK4F)+Hv) z{PWElV8)*y!x%No5+5o|@mZ- z-*ddy%e_PkOf+w@$NhGui!g?^d_caR+q4j%@kB@3L0&z+hf5g2M;g31@LQ7}Rm-S# zrwDj+fBl?bc~#i(BIz>(^IM0L9J2Nz8)JYUM0gF}I6Bv>q1^5I+a1R{C;e%tw2n+$ zK1K0Xtq)IOvP9w*irB-P3Qp;zHtYKu5G2$T4xMUlI|g#Lrwaaka|$RsUWALuzAybfe1rnb&m386N~7z~_#g4V<1o1!G@faP}E`ZiUUCy~{XGm#PD z?dIGqf3r=c?R?wF4RJ|pCia5BkPZ-x=P8uU8FXB8=rY(m2|&9!HElI-tMJYv*f`vU z5KjpJc2>X3yx2Me>h$)TQ*>RgVcNrZc10Yk6{3BBh|5&deF-O&0bpnS zPa~3#516E9J&~_~)x$;q_1W3t9E|@7X5awtkOi!JnBHOpV+;Tk04(%_^Fb~wfH8N` zK`j`g7({G7Em>PjXE(xS%aP+ZBd$|=5{HQ!@wVOq0385Ek|!-6o1z}2$80&(SC{~B zwqH+n7b-}^f%1I`%%SRk2%6j^pfD{e;i>Dy51NQ!2R!31b#Q+2X%>MYg-*$Pk|1fc z6TDx*SPcd_#-=4k2d;N8XEThC^}`JRA~!gV_-ogu8ZSMNvj@?$nEp0Cc#m;mRJX1O z8d^|Ek_`U_1H#(mb&J)Qzbh7<PrHj>)b~)zriEV^Q-3shhx$*^4ka8bW^7y|d}W zvO*#@PQ=Sn$Wdn^2sOrnn4l|giPl+foKSjm*73+(yV}X@ia1OovalxHjwp4_@ze=s zNG+{g7U&SG%iQk7MtR)JLx+=NZC3dr6UjO&<0iBy_ISd%FYIrId55Gw&pUo~Z8^TQ zFeGm3Kd~t0^Ky_Y_N&w@-6maii8Z>?PdALHvEO<@4AjQ&>)16Jyc%mMa9HDSZ)OaN z9`BU9u|V>K_=e+2uecyrV|SjEyqcM;p3ECBEEBXgFUWOfb*Q})8MkCb&~5+jnGZF! zP0TSxNe!9g$)E5puJce7m&7=E_ZqD^s-~`A!YO)410PibBZASu!1Z_wV-On1!^ZXE)nvP@HBDu{4lnTXwnNkGz=gI&MVgwT^cJ7W9{6q}I?r z^0A7c%FIsVv3tqC?YYTk#5OBDBY(C;wXfTvmV!>($;*nN6IJ~S;F2IkZW=Tm(*OB>xcCP)zB&dT?zggaY@WcGi@`HD!y6;ECSFM7nR zg-M;PHA~#FbZ_;zp8OS#66x7y=(YbUc!wzy3DnjiE+)TLk&!~XjwglYE9SlZS-wt( z9bYv|oDVC}>jBO6h8m9dYrHxquY~ocCO)SzM~z>4B-7tMk9T@3+r(&e^UNuAE}inA z$0f#`h}ZnY`RfI$Cd1rP=gopBLSDLB32)y`z%gG+xk>Zg#+h8)>gHJ(^^}}|`qD7F z>yOds+%>W8JDEh!Yf{xUBz1l4R#)qnA~%R~JAB%FPito}jo^MTA`iGTVr z@#$XkI2gHM?G*h$aKZOz3H0GHFDCvT!YMUw&p7jS=Lu@QOL&G2z_}ojPYl0d5(faN z9;5*tEN0F~Skys|^XKo!Wx!O-THkQ@CMC>vO+g0kisE3Rub~XsR6bH5RS6jMcrZLI z=L*1TRj;+u7&x~*GrW7Z=eC2No)nSNDK zGM$MowxsvF#MM0FCK-EPA@W9HT=vwBzrE@XJA^MovHMo|M0nA`IPz@jrZKI2V|v)k z)#`lkD)Zzr{ItL9bed;o$ga(GZ?DUdlvF6Qg#z*yvRid`EtS^IWXcPR zXc?C$>Mkkt>pp^f0h);^4f8tk0JyU`4R8wBIRrSwlwRJ*n&m|bzhXW%*-$u+0u776 zu|sn2hfECilj$fNfNgnsVu}qCv#kL`Ea>0JqP&7opEWJHK2RdyEJr@UCj1Y|eQ-n* z>JRr6Cgax=0>eguAdQ40(PH(g*8WrE*_Ybp*+D$!;^QAJ#M8Ej5pJfx{;W+pMkVa6 zoASGkvwf1FB%Y!Sd8C*4tQA%>hWnZSx`HR@K?4AmGy?U-2a*j;*a4WN{L=?o#!vsS zeBQ#PcmfAosZ?c3*ih2u@Kq$lpIAo;@ScJ(c1vwbX}|;wrxs{znAx&<3xPZ^rkLD+ zlfom2faVWK$DCK5ZCWspA5-ZCL7q7bV>x!6e7LK1XcN9C_EWC=2Bj>eggYj> z$B|53GkJY`6e{7MCU|pgUsd5eKfM1&an|=ItWJAK_8d+(7iSIjrUO^XClq1EF>ME1 zyu=%49yOe-$xBW=T?>;?d89IA4o#J({X^_tR8u`=he45U$N=If#~T_*1Q{drKuCSWCq7zxk+vfU(9vLQQu{7Yo* zA&>t{@P@-s>4t{DUI#dj*Dx?4c(I&dcoABd>I7VS@PCw{z*{HxUrrNJj_?DfkCO(# z8|cU<#2A{-(Baw7rdbC^dyqv3Cy4>FctMP-8?Y&^OlV_~mzW$8<#W5&DUJDJ1XEz98o*V*}2-C)ow>)hR* zY@9<4<{}qPKc)c-_U0*0p6+9i9&uoOg|x%1FCTuztq z>`^b@Vf)=2+x;w@G`a5c(`Ln2U4rr*u5HZrrL0F@`2mX;wIjpodtUioDdY0Cf=^Cx zC$>~nN2jI-jJhDovIo};^Lo#lMJWM|-KQPgkZdVNbfs|{DS4STP(A_T2(nM)!JHpl zt*j*2{Q~s%vQj{ne&Fg6Z>vrcTz-LJpF!RZc2i71{nn>qbQK_sKoANr z@u(UEWma46*XwUlBBMNdk7uBto1w3YE-)aVl5tHpW5xj>kt|kshzMS6Mlsf zz6TjUb+7qa|1Hwco<5WQIL25r89@Te=#J8DKQ4SuS$p+2BE&l3?9Kft)lm5+@2hTG z)!5v-O5RrCb<1gDx{Dg=N-w0RTNzjX2Swx0$ zovuaibz5y2&DgaHM&j{BM%Y_Y?kz#1cVni0Y@YC;04VzWPzlUneeYu9g!x3U$@U4v z0=mi@xqd7w;@HGTc=~HUT9EK?<8qjTQ04fmRzvgab8&AolcLT*6gP$;tMwBuz{2{> zyj8nr&mz(q*ncnRM>gH1GVG!wERwQzz|3pCObfr@#0=Ruu6n!O_jKHikk;0}GfW}+ zR%NL2*k{6fyJaU0!Xe~xh5Y43QN25}NCvXV%EmC-@=4iTy>{xdX)_25tFB&U z$lB?W4E3Agbj!uNghXE9cSFa*J6pqBU2o6Aui7j(7hc|7UVifk1QUaNt){D(G3fA{ zw2p-Wk%I6Gfn?fH8tE(6iu^lq3%%u&ctnVExeS-+3qIDdZhKDMi|(7BUlnb&nQmm} zx+;J8uHo;Pgml~H#dB#awQnBd54X({My76@Dwj|5M6!Ck8 zJaiY~KCQ@yV0LfG`<|A%4ju@m{j?i&Hfz%1a!rwnJ7@H;YBlrDHT>oD;p5nng;lqA z>xEt_=Uo^G{yg5mjK7jcK*q%fuXN3#X{`%x$(R_Kse_kp>_IlpFL&4L@fE`lj|KA+ zfwg7$IRSCT(noc-z0jE-d&5&Oy!Zp|1DnJgWFY7;Vcjd0GAoE+M4y0e#W$M|mTdnh z)&Wb6z$C^2Hg55eC{6d-AsmKT3_kK`DPUEAt{>&qCXZhZ4)DgF82JWsGNF??Yg2>q zTQ7LvGYyEb#k!kILD!B6Lrh9w4HkmF3Y&fJme2!Q(K+l6@EWp!q~sTicYc!uMvPao zfFE%4HvkoekXDMtj=T{g->m>GG^%H%SV#G1|5*o{OC!SglUXH02!axW53(B3AXa-i z8WMVakY;#0qJIKc+kWRRrD{}fLk6lxzyF7L>C*-a)}-67sFa?-Xju=z08)+&aDzxPcmaPIC+wWVF8mzcDVRgyZI)1dY@pHFyOvn z2iE{`IO1$qaL0hg6KLd93C$MR5}{g^GhPDWas?&9!}2?F+%on>XV;!E?i`fHoG`G1kod5`LR|z0ULmk z^nn%ipJ49(6AsXWY0v<*dSF_b=D&;m)>Ik51i`?D3kLpWm}=4^(RcY?WP(Q|ut?wu zQ2zmHPBhv;5AlvqB4qr^YkQUXj%F2;FdfK;_!!oZ|EjE>74&-pN?pOkpzgo)kX;17 zunI(i6k*?BAuAjlOgsS&UhDw&(A3l@gEJlhcmaj~`(-~eI6C?KSDBnf8RsN_zrZFK zqOepC5Wz|Z=YDupFz8jqVdLk~Lz-V&t{4E_OwD2K&e8?4ZlCoaW3Oj{xB}2~?}e2l zecY(|0Gg`+E)_jMr9L6oY=+F8zj2$L z=Q&`=AQQ0MiW@sA2SGd{iQe-0EZ*U6R0Q4>`6mgflA$cl5nFj&*wX>@7GM%Sp`cy~ zPELHN^)wW8IT)A|;$SWy+S~3ZA;}0h75p^A2Mo*`cbdN%eB5iAd525}FI*p+D>;Mf zM|Q-Im_ zf={#Q=fb&(X~xECVcSZh$br*QzQ*@005Rvko_r;`Qdj~~+|t=Bz@8x7_yLr^``|o; zEmRERU2Gr&T9p+CI&vj`Q#NqZWbt8>rzH)m`)D8v@=y>B{-GiuBFDvFplNk)74L+; zOh4eQ14G96#EK@uoL!UhL_&Nhr(De+Js@N$LS|vtk)RelUoQVMqcx2N=)VWGSU>Z= zTeCX!tFiKFQ`ZL2gGuq;Aw?^@niJR9%=qfv-!F5_T?khd1~6@%^n@A6+X>6>6}12}~>IK|w4;HJ|pIPU+u@NufO*6;m5T(D&T*wUby zNb~oZMV!~O)IV0|3UaBOTC;gGV>E*a+-5&&_NF&0#>QwoQ+LZO&%GE^|7gwRE%j~o zPW5dX)KrQRqzI7fW-~PL|`_5@6+DAer zio!8650lc|*mA31{Do-@i7(t2amu0bJKx)=8@brB$HBrSC@uR$t-~kMIswAPC40NM z#MQNXFNe!>XM~77he!7_z&}#e?vVxulLx!pAwf=K*;ax<@~eE7Si=T!E@(tQvj+r& z$}fof#_UbehshO$An<3zX;40gI`J(xw1r(hhZ0(ceB~BHRkVdIK8MV$5u*(8MAz0_ zfkWJ&XvzC* z)q+89&xv16+4ranlkYd{AS)j5yVy^U9+rQ(Ml;wwSXCLcf1-hoSCt{2_XMrL21h? z-73C&gH{9;5X4$qiMfQWF-2d>7V-#^TK%`Iz7TpO{hzPdwH`rJCnTEv&Zf-XMAJJg zo3^IRODjc}Xo_8Ayn!1>`W`{ZYXUX-BA*9x#KRh={Kdnr1tK*ZTm)M?){aSLe>;Q! z#N}=T%I^dM_p%~k3*Y!a+2B2bsxCkmTY=)mpC{Mq=>4sm$%Q zYQ`sv=+Ith$IB9*w_MAe@0Mzah_WLh+u#=Nv+{_ayQHf-R_5;<;1=$1nMCl||NsA_ zkdG_Tk6?dmj{D1oOTQqkU!pvb$!^eu&q+M?1ulO(6W?~j7LrIUc0pRhqCD})ZdioR zbv*Xbd~3qc?WRXp$vdod zPNS}NQy1^PSV8#&`!@sp2q|%C3qONo%ztf~RY@1i4xYo~#v+Bqy+rY&;Fv?88*d$d z`6%S|@t`42)hEnfebt|o6GfE!vYpwB7~Q_XpYX}!<)9v%Tdu^2sk*dn7KI5m=OhP9*$_9%IPeiDQl5z|#*U4B#fHv1jH5uy?QQgogaq z(iv3B94V;6H%<8-opMVY%Nc|=lVc{Go5YmN=PaHwv@QFqBH6abT2wQM|GLuWjkcK7 zX4-Ru>~$GY)yku{K?Ws1;EUEhi^P0BDH#|zV@=sB3@CUpWJ?Y)y`~B)8f%J@w0%>y z`wnYBokbwuuQ=U{oP33W%RlucX0W_HW*eKnru%LXlC+^^KI%AC(if7LDtCLoaWy{{ zdo(3=`!*KVu{l?)fDxoIl1H|bN)s~Ay+5xAsby{c#pP3Ks#o9jAQvlywe&74)vE6!~{Zk zCCRZN7f$#kWyE!nI*i4AJ%>+%TMa&}2_@3B_Z3LbzrCVzjd48BRqGaI`D|G9ZJrgg zCVsC2sUHccttRHpr{rn@Utd*@lrK(?BOaGHMErqrk7;~NvXZXTfsBO4#tk3hGd}<*;6)1bV${B1CE--a`=b`+K$fr)qsyfliA+R$c6Wt zBmcIC`n3t<1=b2jNPXXSU`B%e zgc-zRKkA_#<>#rBag2HO{gDZoaO{4XMotW`&NTnb zWkv3_>S0!i`;1a|Vk~;n?o@#`(F1|xC}|>d8Ioa-OBh;?-hX_fIxHJ)E&19bg7~qN zNa_1N*9OfT;=oUQkPdA4yzp%6ozL94`iK;Z3*>mNb0?+&nu6QC2OnFsEj5C@e3dr{ z<%s$DpTlt&lN+3>nSO6DW!z-he~e*{teO>16!zZb^fL-KB-Y6H;3?@hsD`CRSWs33 zK~jvq6_Uy=K7Y*{+4`56CGEd?ZUQAr%@x<#o^8(e!oAx-kK;=vC%sq^O2tWlE7dqF zoQ|6_b(|U9{#3x~+_d)*Yu=Aw@NKV$gy~C%H0F4!4+brb_EP%Nc-0JlKe6^uM#J}n zu5_7m{%xSsgYy~u`K{*pXzr8vj^+<+6Z7=h$!0Yo%Gu^4e*)mY)0I3jbc!pUd#Z>u zqIz3ZDJ!kD@;w*vu50xZHCz}Tv2V}QSbTKIBety=5sSC`VI`s%e(4u)af}{LPf+ z*i*XpZeoo$y^HGpXD|>46x3uh_{?tmQg$|G{VG(<^LGD_ z%I0w2I;+ktwoBH=(Vo-`|D6`Xd@nxeRzXAA(4|`us!lbu^^vxJ@wuC1F^OGJsh4D& z#~TWdu>I%38jUpXO^IJ}_=^lv@DF}J7^>#Yj(Ofbxh^CJFR3Sln@`Z7))_;G%%h9i zGp#Vkhq7t=x^Lmt0?n0n$9Lws0z&PDz^mE7`1AR@o;@oov)QfyH_ntl&5K`@^vEt- zGDwxK%buNCTC_pYIp_8GJ~OUW-@hy^LpDGS4{%hll)qOEF!MN*5FOLPr8HjVqvx&D zbXVM3_e{`-KTaFMXUH7dc~!ChS*{~(oZ@G#HHxp8cwLzjT+U-B$*3K7D=I%WOHA7C zlox|+-$|1RXUEBtR-A{@Ro)eb4u__#eltP&3Q+216cPjkL;Sp9?v;GgHPl##S8**}P}5Mod*nYkot) zt!)(K1Hr*zL%y}qTPdR66r#yqRLjpE_4Hb~@|tLL$9^0~Lh$FS?7Du3)a+*#8@*(P zab@7F6OB7Q@ie&1;Cs8FU=BToC2qx@d{sM*Ctp{2tNlv`eA!^abUZ8HQH#JSD$C73 z)-3vbxd}^1B5J-*u<51^c|Hn1#jxuc183_i?G5j&|{ zffZ?)G~SpHj?6JqaZnQC7&tv$`+gy2dOd+D6g%X73k~~{82lz@!06sd{dl@Hry#Cq zf>AK)c?wP4@^VLFXI0%~oCr7Fv!9p`^pr1p-Cs*+BIDYek0E6Xt^+*{}86nGxBUvLv^& zaDQ_SOx!E{=?%Ptuzr`rDhWp?9icn&7-CdLS=XZ-Gqt(Q^Ss~k$+&7N?Ws}*EQ#!dP@ zVc%wc@*)O*o+ggNi~MIiv@6!=O);vh>&|2Z1xs`&nuO%;Y&+=}Gza2NQraE6)^_DLR9CvixZENfz`Y|BB>%fz&5g$|_?-z4VW>`YBuO6${n63=6d=QwX;1J^A%CGq;o@g;nvPc8wH;32*nKT|RkLA67EH5p4{A)TP*wTSb~+APBa7ue3N&S_U_ z5mL6R#;YSwzj063h{?S%RPS{#52K_rnuj8l-)jLaUIw6>sFeetMgD`C=G z?eqOOK^4Mxa#h4h(eqr3%I}Bylc(G>hldw+Z*4x=jge%A@$d*^=C^wAD`V^ax#$Y1 zoXt&XCYm)8LF?MsPq}-c1g+dy6dcboU61_Y&~XytzdWb#0xM{KM!(VsUa=l~8Tlh) ziBv1XRer$H=JnA{ByFbo_YxO@eYES0`mdU-NUf4Jzd1k5(PDnd$BcNfuiJy@f%y@c zj@CYKVJJxyxxIbXG|i`A*rv{OcC7*Klmuz8>-4#29)UaKI2V1tj-Sdyv9~>_Pz%+ei0#U^7+q7b0Z9=Cjc>+u7q{{eq8Ae-yZWhZgxK zXeyGbdQp&%Ab0t_xTS+XEH*R2qh@L};3FkYOBzK!9(DI>Njm!7`a!%l#@Vyd-p1jI zaNqR&k$`}M{AT@EXZbAcT6EnfaDRygT#q1&S}ipC0WViKQ?vw%j6S_)7xD8$d|R;- zyTcQeVTSQ1?H3oGZ=uU7#_i=a9)tgB(_W}*i2m*pEg=R9^H;dmtujSRPs;TaC|qxg zv8s|PZ&ISR*egkQ&*ImmAFjF9*h#cH^SZ&)I{ehVU%Z_D`j%l#5q*;B0wIc|J3-`F zTxAhcP|@0c@UReF>aR@0^6?hhTB?#{rKru^-<|ImVMoL1W_=YJ=D~W|!8Og&nPy4% zz8@FiLWH9i*~=uFD;pmg5&I3m^tyFO<#8c4r~Jp^FmG%k01BlWWl*EbTa3|3QGsUCXU2( zB5C`3E-O{izn6 zr)K&>`*@nDzOSF1;T)>{yVfd)!h6!6DX(a&eS-CiCuPK#w++66Y8H$VeXRhiY8~b?X~hH0oK=E?+C-M?-O6iN*Ph7ls<>5g>-St zq^zWzHei;pb2q{Vo|WGs1S*qPMKGE_Y26ErC$4r)Mx(!Zwh?4*ok~3){jHAkRl*Bl zm$S;4H|!-suX0|lsr-j|VBjUFBC*rfLXhM@(IFEtu|C#Bt6UK&3~#n1dhB%HiX)kF=|IQn(@y~sPi z;{;=KG=oKn-bdlbNxT?Gxl74Q>rc;d)L%W;EjytTGpv1DUW&VwaD5Q|_)JF#uAN6` zVoG_3Tv>xdv&fu#=fipzQit5D(Mc&hLMyIYB&2|+g&V>Q7l8_jiaavTE7jJ7Lb<&m-a_3=nmBl{&BWmzFe1*Dj*D6O)yxA3UfP`FPB{ah$6ssmtg3 z3EMi4&}d{AIcvQ4=JxhFY}z+P8{9opTYCKj_4|V}Kj_&UbH|+Oe;tf9-=njPhwtlx z(tKHG>vK4if_N8dx4!?Z%&lyzk=yfOsm3}7*RI5EtuT~e$@C`LGOeg%6(PNRqHiSM z`_gy5IJ;$-Juf%IMGp616w`rrHK@4fn}+U^!w+ME3M|gc=a$cu^AQ*~SXnkcjvWPl zB^n+?{X+eDuKwFsx#kG2a_BmD&$1z@#yck>B?Ug3Fr>p|z7a8n_c4D@d>bF%xOg_z znbk5(dv?4*@py}gfM9j&|Hk)_B&V#znU%;$GQiRaJOBQA_M3|_s?J@3GI?gM`2_u} ze9s%%bmOyX6ZvnycaXh&>*x6fQ=ez6L%b^7ohC?hg4H(&k2>QP={OJ;v)lz^(2JYQ zi5x0Kv>6*3l{OrlzE9$W7>*DKQp%l(F1U8*n#v|VO zB1cVdoVo@l9X-ZTk2G_+hn<|f%fyJn~c~dY*c04w}A^~*}om%W^ zZ99Nu0?+a`1yLrXC9g5j$Idb&Ik}RAr`Ra7ey&1^$bTHE|LR@3ZIX3lPjHE){PE8) ziVY}D@nh7*u4`+}Q_J$hvLlAR@(NndJ3)`2wr=8g4vg}U3f34dc`sL6Mop35GtwTe zgC#QMs&!4JzxZyV0beLR;M(m&T#cI*3Ku7*gRAg-Go^zo`8&y+h3Sk1%l#?p;Ajbf zppek!eur6U!!sJS@u%->i6)TSYy$Af3qwi1>>rYqv%ArC-=&Twc)znhj6d1Jh5u9B zdY9guJy{>#O~vqfjh~Leygy7{)Q{rhF@m}Lmv%OP<&ykn%>2XsTn@HP9@>(y9Qimd znq~W7A{(NPKZb7PV{I#rqZk?*+q<~axhXOo?1r~YV|5A=8@g)tgL|oRgTZHFCp50? zk-;`;(r?t~>#H7fcdzfwNeW7e$HBk1O=V}^&6*m+AK*XxL938VSQPV$>*Kg|&7Mdq zJLVQT zV#ODqnWcm}dIi2YP+sFgjIGh4h;Wl=;5qS$JaH#HRf|*BS|#tUZ$jX*6Mx&%$-ER} zy57ymBoWL)5Hd62W~U`MVt|dul5(T*_TAOMcK7D9eSgHh)VPd#Q=bgOkDPE& zv>F7FZHnaQ71u&BOW0Bbj*3Qiv=gC8&9jL?s-MH3K}GimvirSG)|9BM#QE%A!+W_* z&(cbvFhgZHhZg;V2Hp}qH?nsP$ey83JECP$pZ9&V^tNHa#|^og*{3`DyO&a11M7*4 z*YEoH&f{wu-A%~OudubIm8T5ml1WmhsqUp|O*Y>Goucm^IfkvBy5=?~6a?*dFcu=w zk2E8zZ3m*~S=&nxp+b9Y4yH zAZM}p%XeX?Ry1vyN4{0-*HqUG-+s-9L$Vl>3z(NH4il%<2-Qcq^av+IU-0-VhaC;x zefr%ZjQ1{LtZ0_8Y{y@-&8A!d%}prA06l$!=h!N(IZ8n4)32OKnqo$iU#Xp2T6b=K z1b*UOTi5umLSjVIHC}I15BGbK|mO1#pb| zoso6hrlFru!Z<4kY>q`~ngQ4-uKWryC-SI8x;wMg=d85 zh!Q+SuqX7#;^3#_&&-=)J2u~G`lXtuN<|us9r+(*x7~7&7dBkRFrnVLdsdjEUh2(+ zzEkf=rFmzTUfEbTXP!41CI@@!@RNrbNhqQhOT^v}ypZvN7a_al`3r@5-_PB@--z<6 zy4&w{4u?`fsIFOZN9AR0vW_;cw`}$@Ayzc9`|YZ!Au3;LlIiB&#=}n-=U8$m7yEF( z$k&)R&Y6HL8s}&ufHkw6wGUfZ(e!b@FiH)n8kCqZ&M74aNARQrAE>_{_7pbfP~Oc1 zo0hDCL-5sr4|r1!zM+8r_X&?>uq@V{@Eb3Hf{71F=9hfEsh%m@Fs)mH!e7?v4>+%KrD zIFxftA5NIR=mf5>_`i0sgM)#KXBRPRoWryN)?;OZUv&h|N@xdu0YS;2M952U32ckO zhg|2w#wYjWFE&I@-o{6*Y~^yz4vWXeLG4~e6u!5Mi$(HOrO8-dx~;i8q$Mi3Pb55u ziCI3`vaDpXyQVCZyHiJ@_vS1upx2>t{`0wVKwX_vdW@~Q@(M#(rRl^n9^2Lnu4Pk( qnvUr^Rk@P4@%i-`xc>vi;}5|A literal 0 HcmV?d00001 diff --git a/tests/testthat/test-method-differentialExpression.R b/tests/testthat/test-method-differentialExpression.R index d0794ee..48d0a6c 100644 --- a/tests/testthat/test-method-differentialExpression.R +++ b/tests/testthat/test-method-differentialExpression.R @@ -2,26 +2,8 @@ test_that('differentialExpression returns a correctly formatted data.table', { - df <- testCountData - nSamples <- dim(df)[1] - testSampleMetadata <- data.frame(list( - "entity.SampleID" = df[["entity.SampleID"]], - "entity.binA" = rep(c("binA_a", "binA_b"), nSamples/2, replace=T), - "entity.cat3" = rep(paste0("cat3_", letters[1:3]), nSamples/3, replace=T), - "entity.cat4" = rep(paste0("cat4_", letters[1:4]), nSamples/4, replace=T), - "entity.contA" = rnorm(nSamples, sd=5), - "entity.dateA" = sample(seq(as.Date('1988/01/01'), as.Date('2000/01/01'), by="day"), nSamples) - )) - - testCollection <- veupathUtils::CountDataCollection( - data = df, - sampleMetadata = SampleMetadata( - data = testSampleMetadata, - recordIdColumn = "entity.SampleID" - ), - name = 'test', - recordIdColumn = 'entity.SampleID') - + testCollection <- testCountDataCollection + testSampleMetadata <- getSampleMetadata(testCollection) # A Binary comparator variable @@ -50,7 +32,7 @@ test_that('differentialExpression returns a correctly formatted data.table', { ) result <- differentialExpression(testCollection, comparator=comparatorVariable, method='DESeq', verbose=F) - expect_equal(length(result@droppedColumns), 182) + expect_equal(length(result@droppedColumns), 0) dt <- result@data expect_equal(names(dt), c('SampleID')) expect_s3_class(dt, 'data.table') @@ -86,12 +68,12 @@ test_that('differentialExpression returns a correctly formatted data.table', { ) ) ) - result <- differentialAbundance(testData, comparator=comparatorVariable, method='DESeq', verbose=F) - expect_equal(length(result@droppedColumns), 407) + result <- differentialExpression(testCollection, comparator=comparatorVariable, method='DESeq', verbose=F) + expect_equal(length(result@droppedColumns), 244) dt <- result@data expect_equal(names(dt), c('SampleID')) expect_s3_class(dt, 'data.table') - expect_equal(sum(testSampleMetadata$entity.cat4 %in% c('cat4_a','cat4_b')), nrow(dt)) + # expect_equal(sum(testSampleMetadata$entity.cat4 %in% c('cat4_a','cat4_b')), nrow(dt)) stats <- result@statistics@statistics expect_s3_class(stats, 'data.frame') expect_equal(result@statistics@effectSizeLabel, 'log2(Fold Change)') @@ -121,11 +103,11 @@ test_that('differentialExpression returns a correctly formatted data.table', { groupB = groupBBins ) - result <- differentialExpression(testData, comparator=comparatorVariable, method='DESeq', verbose=F) + result <- differentialExpression(testCollection, comparator=comparatorVariable, method='DESeq', verbose=F) dt <- result@data expect_equal(names(dt), c('SampleID')) expect_s3_class(dt, 'data.table') - expect_equal(nrow(dt), sum((testSampleMetadata[['entity.contA']] >= 2) * (testSampleMetadata[['entity.contA']] < 6))) + # expect_equal(nrow(dt), sum((testSampleMetadata[['entity.contA']] >= 2) * (testSampleMetadata[['entity.contA']] < 6))) stats <- result@statistics@statistics expect_s3_class(stats, 'data.frame') expect_equal(result@statistics@effectSizeLabel, 'log2(Fold Change)') @@ -152,11 +134,11 @@ test_that('differentialExpression returns a correctly formatted data.table', { groupB = groupBBins ) - result <- differentialExpression(testData, comparator=comparatorVariable, method='DESeq', verbose=F) + result <- differentialExpression(testCollection, comparator=comparatorVariable, method='DESeq', verbose=F) dt <- result@data expect_equal(names(dt), c('SampleID')) expect_s3_class(dt, 'data.table') - expect_equal(nrow(dt), sum((testSampleMetadata[['entity.dateA']] >= as.Date('1989-01-01')) * (testSampleMetadata[['entity.dateA']] < as.Date('1993-01-01')))) + # expect_equal(nrow(dt), sum((testSampleMetadata[['entity.dateA']] >= as.Date('1989-01-01')) * (testSampleMetadata[['entity.dateA']] < as.Date('1993-01-01')))) stats <- result@statistics@statistics expect_s3_class(stats, 'data.frame') expect_equal(result@statistics@effectSizeLabel, 'log2(Fold Change)') @@ -167,9 +149,7 @@ test_that('differentialExpression returns a correctly formatted data.table', { test_that("differentialExpression can handle messy inputs", { - df <- testOTU - counts <- round(df[, -c("entity.SampleID")]*1000) # make into "counts" - counts[ ,entity.SampleID:= df$entity.SampleID] + df <- testCountData nSamples <- dim(df)[1] testSampleMetadataMessy <- data.frame(list( "entity.SampleID" = df[["entity.SampleID"]], @@ -184,11 +164,12 @@ test_that("differentialExpression can handle messy inputs", { testDataMessy <- veupathUtils::CountDataCollection( - data = counts, + data = df, sampleMetadata = SampleMetadata( data = testSampleMetadataMessy, recordIdColumn = "entity.SampleID" ), + name='test', recordIdColumn = 'entity.SampleID') @@ -303,26 +284,7 @@ test_that("differentialExpression can handle messy inputs", { test_that("differentialExpression returns a ComputeResult with the correct slots" , { - df <- testOTU - counts <- round(df[, -c("entity.SampleID")]*1000) # make into "counts" - counts[ ,entity.SampleID:= df$entity.SampleID] - nSamples <- dim(df)[1] - sampleMetadata <- SampleMetadata( - data = data.frame(list( - "entity.SampleID" = df[["entity.SampleID"]], - "entity.binA" = sample(c("binA_a", "binA_b"), nSamples, replace=T), - "entity.cat2" = sample(c("cat2_a", "cat2_b"), nSamples, replace=T), - "entity.cat3" = sample(paste0("cat3_", letters[1:3]), nSamples, replace=T), - "entity.cat4" = sample(paste0("cat4_", letters[1:4]), nSamples, replace=T) - )), - recordIdColumn = "entity.SampleID" - ) - - - testData <- veupathUtils::CountDataCollection( - data = counts, - sampleMetadata = sampleMetadata, - recordIdColumn = 'entity.SampleID') + testCollection <- testCountDataCollection comparatorVariable <- veupathUtils::Comparator( variable = veupathUtils::VariableMetadata( @@ -348,7 +310,7 @@ test_that("differentialExpression returns a ComputeResult with the correct slots ) ) - result <- differentialExpression(testData, comparator=comparatorVariable, method='DESeq', verbose=F) + result <- differentialExpression(testCollection, comparator=comparatorVariable, method='DESeq', verbose=F) expect_equal(result@parameters, 'recordIdColumn = entity.SampleID, comparatorColName = entity.binA, method = DESeq, groupA =binA_a, groupB = binA_b') expect_equal(result@recordIdColumn, 'entity.SampleID') expect_equal(class(result@droppedColumns), 'character') @@ -356,29 +318,7 @@ test_that("differentialExpression returns a ComputeResult with the correct slots test_that("differentialExpression fails with improper inputs", { - df <- testOTU - counts <- round(df[, -c("entity.SampleID")]*1000) # make into "counts" - counts[ ,entity.SampleID:= df$entity.SampleID] - nSamples <- dim(df)[1] - sampleMetadata <- SampleMetadata( - data = data.frame(list( - "entity.SampleID" = df[["entity.SampleID"]], - "entity.binA" = sample(c("binA_a", "binA_b"), nSamples, replace=T), - "entity.cat2" = sample(c("cat2_a", "cat2_b"), nSamples, replace=T), - "entity.cat3" = sample(paste0("cat3_", letters[1:3]), nSamples, replace=T), - "entity.cat4" = sample(paste0("cat4_", letters[1:4]), nSamples, replace=T), - "entity.contA" = rnorm(nSamples, sd=5) - )), - recordIdColumn = "entity.SampleID" - ) - - - testData <- veupathUtils::CountDataCollection( - data = counts, - sampleMetadata = sampleMetadata, - recordIdColumn = 'entity.SampleID') - - + testCollection <- testCountDataCollection # Fail when bins in Group A and Group B overlap bin1 <- veupathUtils::Bin(binStart=2, binEnd=3, binLabel="[2, 3)") @@ -399,15 +339,13 @@ test_that("differentialExpression fails with improper inputs", { groupB = groupBBins ) - expect_error(differentialExpression(testData, comparator=comparisonVariable, method='DESeq', verbose=F)) + expect_error(differentialExpression(testCollection, comparator=comparisonVariable, method='DESeq', verbose=F)) }) test_that("differentialExpression catches deseq errors", { - df <- testOTU - counts <- round(df[, -c("entity.SampleID")]*1000) # make into "counts" - counts[ ,entity.SampleID:= df$entity.SampleID] + df <- testCountData nSamples <- dim(df)[1] sampleMetadata <- SampleMetadata( data = data.frame(list( @@ -442,10 +380,12 @@ test_that("differentialExpression catches deseq errors", { ) # Use only a few taxa - testData <- veupathUtils::CountDataCollection( - data = counts[, c("entity.SampleID","entity.1174-901-12","entity.A2")], + testCollection <- veupathUtils::CountDataCollection( + data = df[, c("entity.SampleID","entity.1174-901-12","entity.A2")], sampleMetadata = sampleMetadata, - recordIdColumn = 'entity.SampleID') + recordIdColumn = 'entity.SampleID', + name='test' + ) expect_error(differentialExpression(testData, comparator=comparisonVariable, method='DESeq', verbose=T)) @@ -454,22 +394,23 @@ test_that("differentialExpression catches deseq errors", { test_that("toJSON for differentialExpressionResult works",{ - df <- testOTU - nSamples <- dim(df)[1] - df$entity.wowtaxa <- rep(c(0.01, 0.99), nSamples/2, replace=T) # will 'wow' us with its significance + + df <- testCountData nSamples <- dim(df)[1] + df$entity.wowtaxa <- rep(c(3, 1000), nSamples/2, replace=T) # will 'wow' us with its significance testSampleMetadata <- data.frame(list( "entity.SampleID" = df[["entity.SampleID"]], "entity.binA" = rep(c("binA_a", "binA_b"), nSamples/2, replace=T) )) - testData <- veupathUtils::CountDataCollection( + testCollection <- veupathUtils::CountDataCollection( data = df, sampleMetadata = SampleMetadata( data = testSampleMetadata, recordIdColumn = "entity.SampleID" ), - recordIdColumn = 'entity.SampleID' + recordIdColumn = 'entity.SampleID', + name='test' ) comparatorVariable <- veupathUtils::Comparator( @@ -496,9 +437,9 @@ test_that("toJSON for differentialExpressionResult works",{ ) ) - result <- differentialExpression(testData, + result <- differentialExpression(testCollection, comparator = comparatorVariable, - method='Maaslin', + method='DESeq', verbose=F) stats <- result@statistics jsonList <- jsonlite::fromJSON(toJSON(result@statistics)) @@ -514,24 +455,22 @@ test_that("toJSON for differentialExpressionResult works",{ test_that("The smallest pvalue we can get is our p value floor", { - df <- testOTU - counts <- round(df[, -c("entity.SampleID")]*1000) # make into "counts" - counts[ ,entity.SampleID:= df$entity.SampleID] - nSamples <- dim(df)[1] - counts$entity.wowtaxa <- rep(c(1, 100), nSamples/2, replace=T) # will 'wow' us with its significance + df <- testCountData nSamples <- dim(df)[1] + df$entity.wowtaxa <- rep(c(3, 10000), nSamples/2, replace=T) # will 'wow' us with its significance testSampleMetadata <- data.frame(list( "entity.SampleID" = df[["entity.SampleID"]], "entity.binA" = rep(c("binA_a", "binA_b"), nSamples/2, replace=T) )) - testData <- veupathUtils::CountDataCollection( - data = counts, + testCollection <- veupathUtils::CountDataCollection( + data = df, sampleMetadata = SampleMetadata( - data = testSampleMetadata, - recordIdColumn = "entity.SampleID" + data = testSampleMetadata, + recordIdColumn = "entity.SampleID" ), - recordIdColumn = 'entity.SampleID' + recordIdColumn = 'entity.SampleID', + name='test' ) # A Binary comparator variable @@ -560,31 +499,20 @@ test_that("The smallest pvalue we can get is our p value floor", { ) # Try with different p value floors - result <- differentialExpression(testData, comparator=comparatorVariable, method='DESeq', pValueFloor = 0, verbose=F) + result <- differentialExpression(testCollection, comparator=comparatorVariable, method='DESeq', pValueFloor = 0, verbose=F) expect_equal(min(result@statistics@statistics$pValue), 0) expect_equal(min(result@statistics@statistics$adjustedPValue, na.rm=T), 0) # Confirmed NAs are for pvalue=1 - result <- differentialExpression(testData, comparator=comparatorVariable, method='DESeq', pValueFloor = P_VALUE_FLOOR, verbose=F) + result <- differentialExpression(testCollection, comparator=comparatorVariable, method='DESeq', pValueFloor = P_VALUE_FLOOR, verbose=F) expect_equal(min(result@statistics@statistics$pValue), P_VALUE_FLOOR) expect_equal(min(result@statistics@statistics$adjustedPValue, na.rm=T), result@statistics@adjustedPValueFloor) # Confirmed NAs are for pvalue=1 - - # Repeat with Maaslin - result <- differentialExpression(testData, comparator=comparatorVariable, method='Maaslin', pValueFloor = 0, verbose=F) - expect_equal(min(result@statistics@statistics$pValue), 0) - expect_equal(min(result@statistics@statistics$adjustedPValue), 0) - - result <- differentialExpression(testData, comparator=comparatorVariable, method='Maaslin', pValueFloor = P_VALUE_FLOOR, verbose=F) - expect_equal(min(result@statistics@statistics$pValue), P_VALUE_FLOOR) - expect_equal(min(result@statistics@statistics$adjustedPValue), result@statistics@adjustedPValueFloor) - - }) test_that("differentialExpression fails if comparator has one value", { - df <- testOTU + df <- testCountData sampleMetadata <- SampleMetadata( data = data.frame(list( @@ -594,10 +522,11 @@ test_that("differentialExpression fails if comparator has one value", { recordIdColumn ="entity.SampleID" ) - testData <- veupathUtils::CountDataCollection( + testCollection <- veupathUtils::CountDataCollection( data = df, sampleMetadata = sampleMetadata, - recordIdColumn = 'entity.SampleID' + recordIdColumn = 'entity.SampleID', + name='test' ) comparatorVariable <- veupathUtils::Comparator( @@ -612,6 +541,6 @@ test_that("differentialExpression fails if comparator has one value", { groupB = veupathUtils::BinList(S4Vectors::SimpleList(c(veupathUtils::Bin(binLabel="binB")))) ) - expect_error(differentialExpression(testData, comparator=comparatorVariable, method='DESeq', verbose=F)) - expect_error(differentialExpression(testData, comparator=comparatorVariable, method='Maaslin', verbose=F)) + expect_error(differentialExpression(testCollection, comparator=comparatorVariable, method='DESeq', verbose=F)) + expect_error(differentialExpression(testCollection, comparator=comparatorVariable, method='Maaslin', verbose=F)) }) \ No newline at end of file