## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = FALSE, message = FALSE, warning = FALSE, echo = TRUE, eval = TRUE, cache = TRUE, fig.align = 'center', out.width="65%" ) ## ----load--------------------------------------------------------------------- library(standR) library(SummarizedExperiment) library(ExperimentHub) library(readr) library(dplyr) library(stats) eh <- ExperimentHub() AnnotationHub::query(eh, "standR") countFilePath <- eh[["EH7364"]] sampleAnnoFilePath <- eh[["EH7365"]] countFile <- readr::read_delim(unname(countFilePath), na = character()) sampleAnnoFile <- readr::read_delim(unname(sampleAnnoFilePath), na = character()) ## ----------------------------------------------------------------------------- colnames(sampleAnnoFile) sampleAnnoFile$disease_status %>% unique() sampleAnnoFile$region %>% unique() ## ----new_sampleAnnoFile------------------------------------------------------- new_sampleAnnoFile <- sampleAnnoFile %>% tidyr::unite( "disease_region", # newly created grouped variable c("disease_status","region"), # variables to combine sep = "_" ) new_sampleAnnoFile$disease_region %>% unique() ## ----readGeoMx---------------------------------------------------------------- spe <- standR::readGeoMx(as.data.frame(countFile), as.data.frame(new_sampleAnnoFile)) ## ----selectedTypes------------------------------------------------------------ selectedTypes <- c("DKD_glomerulus", "DKD_tubule", "normal_tubule", "normal_glomerulus") toKeep <- colData(spe) %>% tibble::as_tibble() %>% pull(disease_region) spe <- spe[, grepl(paste(selectedTypes, collapse = "|"), toKeep)] ## ----filter------------------------------------------------------------------- filter <- lapply("SequencingSaturation", function(column) { cutoff_value <- 85 if(!is.na(cutoff_value)) { return(colData(spe)[[column]] > cutoff_value) } else { return(NULL) } }) filtered_spe <- spe[,unlist(filter)] colData(spe) %>% dim() colData(filtered_spe) %>% dim() ## ----speQ3-------------------------------------------------------------------- speQ3 <- standR::geomxNorm(filtered_spe, method = "upperquartile") speQ3 <- scater::runPCA(filtered_spe) speQ3_compute <- SingleCellExperiment::reducedDim(speQ3, "PCA") ## ----.PCAFunction, echo=FALSE------------------------------------------------- .PCAFunction <- function(spe, precomputed, colourShapeBy, selectedVar, ROIshapes, ROIcolours) { standR::drawPCA(spe, precomputed = precomputed) + ## really need as.name() plus !! because of factor() ggplot2::geom_point(ggplot2::aes( shape = factor(!!as.name(colourShapeBy), levels = selectedVar), fill = factor(!!as.name(colourShapeBy), levels = selectedVar) ), size = 3, colour = "black", stroke = 0.5) + ggplot2::scale_shape_manual(colourShapeBy, values = as.integer(unlist(ROIshapes)) # as.integer() crucial ) + ggplot2::scale_fill_manual(colourShapeBy, ## colour() is a base function, so must be avoided values = unlist(ROIcolours) ) + ggplot2::scale_y_continuous( labels = scales::number_format(accuracy = 0.1) ) + ggplot2::scale_x_continuous( labels = scales::number_format(accuracy = 0.1) ) + ggplot2::theme( panel.grid.minor = ggplot2::element_blank(), panel.grid.major = ggplot2::element_blank(), axis.text = ggplot2::element_text(color = "black", size = 16), axis.line = ggplot2::element_blank(), axis.ticks = ggplot2::element_line(colour = "black"), axis.title = ggplot2::element_text(size = 16), legend.title = ggplot2::element_text( size = 16, vjust = 0.5, hjust = 0.5, face = "bold", family = "sans" ), legend.text = ggplot2::element_text( size = 16, vjust = 0.5, hjust = 0, face = "bold", family = "sans" ), plot.margin = grid::unit(c(1, 1, 1, 1), "mm"), plot.background = ggplot2::element_rect( fill = "transparent", colour = NA ), plot.title = ggplot2::element_text( size = 16, hjust = 0.5, face = "bold", family = "sans" ), panel.border = ggplot2::element_rect( colour = "black", linewidth = 0.4 ), panel.background = ggplot2::element_rect( fill = "transparent", colour = NA ), legend.background = ggplot2::element_rect( fill = "transparent", colour = NA ), legend.box.background = ggplot2::element_rect( fill = "transparent", colour = NA ), legend.key = ggplot2::element_rect( fill = "transparent", colour = NA ), legend.position = "bottom", aspect.ratio = 1 ) + ggplot2::guides( fill = ggplot2::guide_legend( nrow = length(selectedVar), title.position = "top" ), shape = ggplot2::guide_legend( nrow = length(selectedVar), title.position = "top" ) ) } ## ----PCAFunction-------------------------------------------------------------- .PCAFunction(speQ3, speQ3_compute, "disease_region", selectedTypes, c(21,22,23,24), c("blue","blue","black","black")) ## ----design------------------------------------------------------------------- design <- model.matrix(~0+disease_region, data = colData(speQ3)) # Clean up column name colnames(design) <- gsub("disease_region", "", colnames(design)) ## ----convert------------------------------------------------------------------ library(edgeR) dge <- SE2DGEList(speQ3) keep <- filterByExpr(dge, design) dge <- dge[keep, , keep.lib.sizes = FALSE] dge <- estimateDisp(dge, design = design, robust = TRUE) ## ----contast------------------------------------------------------------------ # In case there are spaces selectedTypes_underscore <- gsub(" ", "_", selectedTypes) comparisons <- list() comparisons <- lapply( seq_len(choose(length(selectedTypes_underscore), 2)), function(i) { noquote( paste0( utils::combn(selectedTypes_underscore, 2, simplify = FALSE )[[i]][1], "-", utils::combn(selectedTypes_underscore, 2, simplify = FALSE )[[i]][2] ) ) } ) con <- makeContrasts( # Must use as.character() contrasts = as.character(unlist(comparisons)), levels = colnames(design) ) colnames(con) <- sub("-", "_vs_", colnames(con)) con ## ----limma-------------------------------------------------------------------- library(limma) block_by <- colData(speQ3)[["SlideName"]] v <- voom(dge, design) corfit <- duplicateCorrelation(v, design, block = block_by ) v2 <- voom(dge, design, block = block_by, correlation = corfit$consensus ) corfit2 <- duplicateCorrelation(v, design, block = block_by ) fit <- lmFit(v, design, block = block_by, correlation = corfit2$consensus ) fit_contrast <- contrasts.fit(fit, contrasts = con ) efit <- eBayes(fit_contrast, robust = TRUE) ## ----tables------------------------------------------------------------------- # Keep track of how many comparisons there are numeric_vector <- seq_len(ncol(con)) new_list <- as.list(numeric_vector) # This adds n+1th index to new_list where n = ncol(con) # This index contains seq_len(ncol(con)) # ex. new_list[[7]] = 1 2 3 4 5 6 # This coefficient allows ANOVA-like comparison in toptable() if (length(selectedTypes) > 2) { new_list[[length(new_list) + 1]] <- numeric_vector } topTabDF <- lapply(new_list, function(i) { limma::topTable(efit, coef = i, number = Inf, p.value = 0.05, adjust.method = "BH", lfc = 1 ) %>% tibble::rownames_to_column(var = "Gene") }) # Adds names to topTabDF if (length(selectedTypes) > 2) { names(topTabDF) <- c( colnames(con), colnames(con) %>% stringr::str_split(., "_vs_") %>% unlist() %>% unique() %>% paste(., collapse = "_vs_") ) } else { names(topTabDF) <- colnames(con) } ## ----tableExample------------------------------------------------------------- colnames(con) head(topTabDF[[1]])