{ "cells": [ { "cell_type": "code", "execution_count": null, "id": "prostate-definition", "metadata": {}, "outputs": [], "source": [ "############# Figure 1a. Permutation Test (Global Trajectory Differences stable vs progressing)\n", "### In R\n", "\n", "df<-read.csv('df_data.csv', header = TRUE, check.names = FALSE)\n", "\n", "##> df\n", "## Time Series_ID Replicate Measurement\n", "##1 0 stable 1 2.0\n", "##2 0 stable 2 2.0\n", "##3 0 stable 3 3.0\n", "##4 0 progressing 4 2.0\n", "##5 0 progressing 5 2.0\n", "##6 0 progressing 6 5.0 .....\n", "\n", "# Ensure factors are correctly formatted\n", "df$Series_ID <- as.factor(df$Series_ID)\n", "df$Time <- as.factor(df$Time) # Convert Time to factor for stratification\n", "\n", "# Run a permutation test on the interaction effect\n", "perm_test <- independence_test(Measurement ~ Series_ID * Time, data = df,\n", " distribution = approximate(nresample = 10000))\n", "\n", "print(perm_test)\n", "\n", "############# Figure 1b. Calculating change point \n", "### In R\n", "\n", "library(changepoint)\n", "library(dplyr)\n", "library(bcp)\n", "library(rstan)\n", "\n", "# Load data\n", "df <- read.csv('df_data.csv', header = TRUE)\n", "\n", "# Convert Time to numeric if it's not\n", "df$Time <- as.numeric(as.character(df$Time))\n", "\n", "# Aggregating measurements by mean and incorporating actual time values\n", "df_aggregated <- df %>%\n", " group_by(Time, Series_ID) %>%\n", " summarise(Average_Measurement = mean(Measurement, na.rm = TRUE), .groups = 'drop')\n", "\n", "# Extract measurements for each series\n", "progressing_measurements <- df_aggregated$Average_Measurement[df_aggregated$Series_ID == \"progressing\"]\n", "stable_measurements <- df_aggregated$Average_Measurement[df_aggregated$Series_ID == \"stable\"]\n", "\n", "# Applying change point detection to 'progressing' and 'stable' series\n", "result_progressing <- cpt.meanvar(progressing_measurements, method = \"PELT\", class = TRUE, penalty = \"SIC\")\n", "result_stable <- cpt.meanvar(stable_measurements, method = \"PELT\", class = TRUE, penalty = \"SIC\")\n", "\n", "# Plotting results with actual Time values\n", "plot(df_aggregated$Time[df_aggregated$Series_ID == \"progressing\"], progressing_measurements, type = 'l', main = \"Change Points for Progressing Series\")\n", "abline(v = df_aggregated$Time[df_aggregated$Series_ID == \"progressing\"][cpts(result_progressing)], col = \"red\", lwd = 0.5)\n", "\n", "plot(df_aggregated$Time[df_aggregated$Series_ID == \"stable\"], stable_measurements, type = 'l', main = \"Change Points for Stable Series\")\n", "abline(v = df_aggregated$Time[df_aggregated$Series_ID == \"stable\"][cpts(result_stable)], col = \"red\", lwd = 0.5)\n", "\n", "# Bootstrapping for confidence intervals\n", "detect_cpts <- function(data) {\n", " result <- cpt.meanvar(data, method = \"PELT\", penalty = \"SIC\")\n", " as.numeric(cpts(result)) # Return the change points\n", "}\n", "\n", "\n", "# Change points for the progressing series\n", "cpts(result_progressing)\n", "\n", "# Change points for the stable series\n", "cpts(result_stable)\n", "\n", "# Original data vector\n", "data_vector <- df_aggregated$Average_Measurement[df_aggregated$Series_ID == \"progressing\"] #### In this case progressing\n", "\n", "# Bootstrapping\n", "bootstrap_results <- replicate(1000, detect_cpts(sample(data_vector, replace = TRUE)))\n", "\n", "# Let's aggregate all change points detected in any bootstrap replicate:\n", "all_cpts <- unlist(bootstrap_results, recursive = FALSE)\n", "\n", "# Now filter out empty results and unlist completely\n", "all_cpts <- unlist(all_cpts[sapply(all_cpts, length) > 0])\n", "\n", "# Calculate confidence intervals for the most frequently detected change point\n", "if(length(all_cpts) > 0) {\n", " CI <- quantile(all_cpts, probs = c(0.025, 0.975)) # 95% CI\n", " print(CI)\n", "} else {\n", " print(\"No change points detected consistently across bootstraps\")\n", "}\n", "\n", "#### Posterior probabilities (Bayesian analysis)\n", "\n", "# Assuming 'data_vector' is your numeric vector of time series data\n", "result <- bcp(data_vector, mcmc = 1000)\n", "\n", "# Plot the results\n", "plot(result, main = \"BCP Analysis of Change Points\")\n", "\n", "# This will show the time series data and overlay the posterior probabilities of change points\n", "\n", "#### Advance Bayesian analysis\n", "\n", "# Example Stan model setup (simplified)\n", "stan_code <- \"\n", "data {\n", " int N; // Number of data points\n", " vector[N] y; // Data vector\n", "}\n", "parameters {\n", " real beta; // Example parameter\n", " real sigma; // Standard deviation of noise\n", "}\n", "model {\n", " for (i in 1:N)\n", " y[i] ~ normal(0, sigma); // Simplified model assumption\n", "}\n", "\"\n", "\n", "# Fit the model\n", "fit <- stan(model_code = stan_code, data = list(N = length(data_vector), y = data_vector))\n", "print(fit)\n", "\n", "\n", "### Once I have identified an specific change point (in this case 2):\n", "\n", "# Extract beta estimates from the rstan model\n", "beta_estimates <- rstan::extract(fit)$beta\n", "\n", "# You can use the mean or median of beta as a representative value\n", "mean_beta <- mean(beta_estimates)\n", "\n", "\n", "# Assuming 'data_vector' holds your time series data\n", "predicted_changes <- numeric(length(data_vector)) # Initialize with zeros\n", "\n", "# Apply the mean_beta effect at the change point\n", "predicted_changes[3] <- mean_beta\n", "\n", "# Visualize the Effect of the Change Point\n", "\n", "plot(data_vector, type = 'l', main = \"Observed Data and Predicted Impact of Change Point\", ylim = c(min(data_vector), max(data_vector + predicted_changes)))\n", "points(3, data_vector[3], col = 'red', pch = 19, cex = 1.5)\n", "arrows(x0 = 3, y0 = data_vector[3], x1 = 2, y1 = data_vector[3] + predicted_changes[3],\n", " code = 3, angle = 90, length = 0.1, col = 'blue', lwd = 1)\n", "\n", "\n", "############### df format ##################\n", "\n", "Time\tSeries_ID\tReplicate\tMeasurement\n", "0\tstable\t1\t2\n", "0\tstable\t2\t2\n", "0\tstable\t3\t3\n", "0\tstable\t4\t2\n", "0\tstable\t5\t2\n", "0\tstable\t6\t5\n", "0\tstable\t7\t4\n", "\n", "############# Figure 1d. sPLS-DA (Sparse Partial Least Squares Discriminant Analysis) of transcriptome results \n", "### In R\n", "\n", "# Read the data\n", "\n", "df <- read.csv('means_human_DE_progressing.csv', row.names = 1, header = FALSE, check.names = FALSE)\n", "\n", "# Set the correct column names\n", "colnames(df) <- as.character(unlist(df[1, ]))\n", "df <- df[-1, ] # Remove the first row which is now column names\n", "\n", "# Make column names unique\n", "colnames(df) <- make.unique(colnames(df))\n", "\n", "# Ensure the data is numeric\n", "df <- df %>% mutate(across(everything(), as.numeric))\n", "\n", "# Transpose the data to get genes as columns and samples as rows\n", "df_t <- t(df)\n", "\n", "\n", "# Define the group variable\n", "group <- read.csv('group_means.csv')\n", "\n", "group2<-group[8:14,] #### Select only progressing\n", "\n", "\n", "x<-as.character(group2)\n", "\n", "Y <-factor(x)\n", "\n", "# Create the predictor matrix X\n", "X <- as.matrix(df_t)\n", "\n", "# Identify zero-variance columns\n", "zero_variance_genes <- apply(X, 2, function(col) var(col) == 0)\n", "\n", "# Remove zero-variance columns from X\n", "X_filtered <- X[, !zero_variance_genes]\n", "\n", "srbct.splsda <- splsda(X, Y, ncomp = 7)\n", "\n", "\n", "plotIndiv(srbct.splsda , comp = 1:2, \n", " group = Y, ind.names = FALSE, # colour points by class\n", " ellipse = FALSE, # include 95% confidence ellipse for each class\n", " legend = TRUE, title = '(a) PLSDA with confidence ellipses')\n", "\n", "# use the max.dist measure to form decision boundaries between classes based on PLS-DA data\n", "background = background.predict(srbct.splsda, comp.predicted=2, dist = \"max.dist\")\n", "\n", "# plot the samples projected onto the first two components of the PLS-DA subspace\n", "plotIndiv(srbct.splsda, comp = 1:2,\n", " group = Y, ind.names = FALSE, # colour points by class\n", " background = background, # include prediction background for each class\n", " legend = TRUE, title = \" (b) PLSDA with prediction background\")\n" ] }, { "cell_type": "code", "execution_count": null, "id": "close-honduras", "metadata": {}, "outputs": [], "source": [ "###################################### Sequence cleaning and aligment with STAR #################################################\n", "\n", "TrimmomaticPE -threads 35 -phred33 sample_R1.fastq.gz sample_R2.fastq.gz sample_R1_paired.fastq.gz sample_R1_unpaired.fastq.gz sample_R2_paired.fastq.gz sample_R2_unpaired.fastq.gz LEADING:3 TRAILING:3 SLIDINGWINDOW:4:15 MINLEN:36\n", "\n", "## Microbiome database generation\n", "STAR --runMode genomeGenerate --runThreadN 35 --genomeDir STAR_microbiome/ --genomeFastaFiles oral_microbiome_genomes.fasta --genomeChrBinNbits 12 --limitGenomeGenerateRAM 10537511861\n", "\n", "## Running STAR for microbiome analysis\n", "STAR --genomeDir STAR_microbiome/ --runThreadN 35 --readFilesIn sample_R1_paired.fastq.gz sample_R2_paired.fastq.gz --outSAMtype BAM Unsorted --outFilterMultimapNmax 35 --outFilterScoreMinOverLread 0.50 --alignIntronMax 1 --genomeLoad LoadAndKeep --readFilesCommand zcat --outFileNamePrefix sample-microbiome\n", "\n", "## Human database generation\n", "STAR --runMode genomeGenerate --runThreadN 35 --genomeDir STAR_human/ --genomeFastaFiles STAR_human/GCF_000001405.40_GRCh38.p14_genomic.fna --sjdbGTFfile STAR_human/GCF_000001405.40_GRCh38.p14_genomic.gff\n", "\n", "## Running STAR for host analysis\n", "STAR --genomeDir STAR_human/ --runThreadN 35 --limitBAMsortRAM 56520374542 --readFilesIn sample_R1_paired.fastq.gz sample_R2_paired.fastq.gz --seedSearchStartLmax 25 --outSAMtype BAM SortedByCoordinate --outSAMattributes NH HI AS NM MD --outFilterType BySJout --outFilterMismatchNmax 2 --outFilterMultimapNmax 20 --outFilterMismatchNoverReadLmax 0.04 --alignIntronMin 20 --alignSJoverhangMin 8 --alignSJDBoverhangMin 1 --sjdbScore 1 --genomeLoad LoadAndKeep --outSAMstrandField intronMotif --readFilesCommand zcat --outFileNamePrefix sample\n", "\n", "## Counts microbiome\n", "featureCounts -B -M -p -O -T 35 -t gene -g gene_id -a oral_microbiome_genomes.gff -o gene_counts_stable_vs_progressing.txt sample.bam\n", "\n", "# Counts human\n", "featureCounts -B -M -p -O -T 35 -t gene -g gene -a GCF_000001405.40_GRCh38.p14_genomic.gff -o gene_counts_stable_vs_progressing.txt sample.bam\n" ] }, { "cell_type": "code", "execution_count": null, "id": "looking-lafayette", "metadata": {}, "outputs": [], "source": [ "####################3#### Taxonomic profiling of microbial transcripts and dual metatranscriptomic analysis ##################\n", "\n", "kraken2 --db Kraken2/oral_microbiome/ --threads 35 --paired --gzip-compressed sample_R1_paired.fastq.gz sample_R2_paired.fastq.gz --report sample.kreport2 --output sample.kraken\n", "\n", "bracken -d Kraken2/oral_microbiome/ -i sample.kreport2 -o sample.bracken -r 150 -l S\n", "\n", "kreport2mpa.py -r sample_bracken_species.kreport2 -o sample.mpa \n", "\n", "python merge_metaphlan_tables.py sample1.mpa sample2.mpa .... > merged_tables_final_bracken_reports.txt\n", "\n", "###############################################################################################################################\n", "##### Figure 2a and b. Clustering species trajectories\n", "## In R\n", "\n", "## Optimal number of clusters\n", "\n", "library(cluster) \n", "library(factoextra)\n", "library(dtwclust)\n", "library(TSclust)\n", "library(parallel)\n", "\n", "# Load the data and compute z-scores\n", "\n", "faithful <- as.matrix(read.csv('means_kraken_stable.csv', header = TRUE, row.names = 1, check.names = FALSE)) ## Example for stable sites\n", "df <- zscore(faithful)\n", "\n", "# Remove rows with missing values\n", "df <- na.omit(df)\n", "\n", "fviz_nbclust(df, kmeans, method = c(\"gap_stat\"), k.max = 25, nboot = 500) #### Optimal number of clusters\n", "\n", "########################################################## Clustering #######################################################\n", "\n", "faithful <- as.matrix(read.csv('means_kraken_stable.csv', header = TRUE, row.names = 1, check.names = FALSE)) \n", "df <- zscore(faithful)\n", "\n", "write.csv(df, file=\"centered_stable_DE.csv\")\n", "\n", "pc_dtw <- tsclust(df, k = 7L, distance = \"sbd\", centroid = \"shape\", preproc = NULL) #### k = optimal number of clusters from previous step\n", "\n", "########## Genes in clusters\n", "\n", "clusters <- slot(pc_dtw, \"cluster\")\n", "\n", "row_names <- rownames(df)\n", "\n", "# Create a named vector\n", "named_clusters <- setNames(clusters, row_names)\n", "\n", "# Create a data frame with row names and clusters\n", "cluster_df <- data.frame(row_name = row_names, cluster = clusters)\n", "\n", "new_colnames <- c(\"ID\", \"cluster\")\n", "\n", "# Assign the new column names to the data frame\n", "colnames(cluster_df) <- new_colnames\n", "\n", "# Save the data frame\n", "write.csv(cluster_df, 'clusters_stable.csv',row.names = FALSE)\n", "\n", "\n", "########## Number of genes per cluster\n", "\n", "gene_names <- rownames(df)\n", "# Create a data frame with gene names and clusters\n", "gene_cluster_df <- data.frame(Gene = gene_names, Cluster = clusters)\n", "# Calculate the number of genes per cluster\n", "genes_per_cluster <- table(gene_cluster_df$Cluster)\n", "\n", "# Print the results\n", "print(genes_per_cluster)\n", "\n", "genes_per_cluster<-as.data.frame(genes_per_cluster)\n", "\n", "new_colnames <- c(\"cluster\", \"number_of_genes\")\n", "\n", "# Assign the new column names to the data frame\n", "colnames(genes_per_cluster) <- new_colnames\n", "\n", "write.csv(genes_per_cluster, 'genes_per_cluster_stable.csv',row.names = FALSE)\n", "\n", "####################################### Plot clusters ###########################################################\n", "\n", "library(reshape2)\n", "library(ggplot2)\n", "library(gmodels)\n", "library(ggalt)\n", "library(knitr)\n", "library(tidyverse)\n", "\n", "\n", "# Read the file\n", "df <- read.csv(\"output_clusters_with_optimal_components_progressing.csv\", header = TRUE, check.names = FALSE)\n", "\n", "# Assuming your dataframe is named df\n", "# Remove the 'ID' column as it seems unnecessary for this calculation\n", "df <- df[, -1]\n", "\n", "# Calculate the means per cluster and per time\n", "means_df <- aggregate(. ~ cluster, data = df, FUN = mean)\n", "\n", "# Calculate stdev per cluster and per time\n", "stdev_df <- aggregate(. ~ cluster, data = df, FUN = sd)\n", "\n", "# Replace NA values with 0\n", "stdev_df[is.na(stdev_df)] <- 0\n", "\n", "\n", "# Reshape means dataframe\n", "means_long <- means_df %>%\n", " pivot_longer(cols = -cluster, names_to = \"time\", values_to = \"mean\")\n", "\n", "# Reshape stdev_df dataframe\n", "stdev_df_long <- stdev_df %>%\n", " pivot_longer(cols = -cluster, names_to = \"time\", values_to = \"std\")\n", "\n", "# Merge means and stdev_df_long dataframes\n", "combined_df <- merge(means_long, stdev_df_long, by = c(\"cluster\", \"time\"))\n", "\n", "# Arrange the data as per your desired format\n", "final_df <- combined_df %>%\n", " mutate(cluster = as.character(cluster)) %>% # Convert cluster to character\n", " arrange(cluster, as.numeric(time)) %>% # Arrange by cluster and time\n", " select(time, cluster, mean, std) # Select desired columns\n", "\n", "# Print final dataframe\n", "print(final_df)\n", "\n", "group=final_df$cluster\n", "\n", "# Convert 'time' to numeric\n", "final_df$time <- as.numeric(as.character(final_df$time))\n", "\n", "# Plot with ggplot\n", "ggplot(data=final_df, aes(x=time, y=mean, fill=cluster, group=group)) + \n", " geom_ribbon(aes(ymin=mean-std, ymax=mean+std), alpha=0.2) +\n", " geom_smooth(method=\"auto\", se=FALSE, color = \"firebrick\") + # Add smoothing curve without confidence interval\n", " facet_wrap(~ cluster, scales=\"free_y\") # Split the plot by cluster\n", "\n", "###############################################################################################################################\n", "##### Figure 1c. LEfSe analysis\n", "## In R\n", "\n", "library(lefser)\n", "library(SummarizedExperiment)\n", "\n", "# Read the CSV file\n", "data <- read.csv('LEfSe_DNA_kraken.csv', header = TRUE, row.names = 1, check.names = FALSE)\n", "\n", "# Extract counts and convert to numeric\n", "counts <- as.matrix(data[-c(1:2), ]) # Exclude the 'Condition' and 'Time' rows\n", "counts <- apply(counts, 2, as.numeric) # Convert to numeric matrix\n", "\n", "# Exclude \"Condition\" and \"Time\" from rowData\n", "rowData <- data[!(rownames(data) %in% c(\"Condition\", \"Time\")), , drop = FALSE]\n", "\n", "# Extract conditions and time\n", "conditions <- as.character(data[1, ]) # Convert the first row to a character vector\n", "conditions <- as.factor(conditions) # Convert to factor\n", "time <- as.character(data[2, ]) # Convert the second row to a character vector\n", "time <- as.factor(time) # Convert to factor\n", "\n", "# Create SummarizedExperiment object\n", "zeller14 <- SummarizedExperiment(assays = list(counts = counts),rowData=rowData)\n", "\n", "# Assign conditions and time\n", "colData(zeller14)$condition <- conditions\n", "colData(zeller14)$time <- time\n", "\n", "# Convert counts to relative abundances\n", "zeller14 <- relativeAb(zeller14)\n", "\n", "# Run LEfSe\n", "res <- lefser(zeller14, groupCol = \"condition\")\n", "\n", "\n", "lefserPlot(res)\n", "\n" ] }, { "cell_type": "code", "execution_count": null, "id": "motivated-accordance", "metadata": {}, "outputs": [], "source": [ "############# Differential expression analysis for time-series and clustering gene expression trajectories\n", "### In R\n", "\n", "library(DESeq2)\n", "library(glmGamPoi)\n", "\n", "gc() ### garbage collection\n", "\n", "countData<-read.table('gene_counts_stable_vs_progressing.tab', header=TRUE, row.names = 1)\n", "\n", "countData=countData[which(rowSums(countData) > 0),]\n", "\n", "dfAnnotationDESeq2<-read.table('dfAnnotationDESeq2_microbiome.txt', header = TRUE, row.names =1)\n", "\n", "# dfAnnotationDESeq2 has the following format:\n", "\n", "#\tsample\tcondition\ttime\tbatch\n", "#sample.001\tsample.001\tcontrol\t0\tB1\n", "#sample.013\tsample.013\tcontrol\t0\tB2\n", "#sample.025\tsample.025\tcontrol\t0\tB3\n", "#sample.039\tsample.039\tcontrol\t0\tB4\n", "# ...\n", "\n", "dfAnnotationDESeq2$time<-factor(dfAnnotationDESeq2$time)\n", "dfAnnotationDESeq2$condition<-factor(dfAnnotationDESeq2$condition)\n", "dfAnnotationDESeq2$batch<-factor(dfAnnotationDESeq2$batch)\n", "\n", "dfAnnotationDESeq2$condition<-relevel(dfAnnotationDESeq2$condition, ref = \"control\")\n", "\n", "dds1 <- DESeqDataSetFromMatrix(countData = countData, colData = dfAnnotationDESeq2, design = ~batch + time + condition)\n", "\n", "########### Optional ############################## Remove genes with less than 10 hits in 10 columns. \n", "nc <- counts(dds1, normalized=FALSE)\n", "filter <- rowSums(nc >= 10) >= 10\n", "dds1 <- dds1[filter,]\n", "###################################################\n", "\n", "dds2 <- estimateSizeFactors(dds1)\n", "\n", "save.image(file = \"dds2.RData\")\n", "\n", "dds3 <- estimateDispersions(dds2)\n", "\n", "save.image(file = \"dds3.RData\") \n", "\n", "### Plot dispersions\n", "\n", "plotDispEsts(dds3)\n", "\n", "# perform a log-likelihood ratio test\n", "\n", "dds4 <- nbinomLRT(dds3, full =~batch + time + condition, reduced = ~batch + time, maxit=500)\n", "\n", "save.image(file = \"dds4.RData\") \n", "\n", "### extract results\n", "\n", "res <- results(dds4, independentFiltering = TRUE, alpha = 0.05)\n", "summary(res)\n", "\n", "resOrdered <- res[order(res$padj),]\n", "resSig <- subset(resOrdered, padj < 0.05)\n", "write.table(resSig, file=\"DESeq_Results_FDR005_No-Spline.txt\")\n", "\n", "gc()\n", "\n", "save.image(file = \"No-SplineDE2_Results_microbiome.RData\") #### Save RData results\n", "\n", "############################### Clustering DE genes trajectories\n", "## in R\n", "\n", "library(cluster) \n", "library(factoextra)\n", "library(dtwclust)\n", "library(TSclust)\n", "library(parallel)\n", "\n", "# Load the data and compute z-scores\n", "\n", "faithful <- as.matrix(read.csv('means_counts_human_DE_stable.csv', header = TRUE, row.names = 1, check.names = FALSE))\n", "df <- zscore(faithful)\n", "df <- na.omit(df)\n", "\n", "fviz_nbclust(df, kmeans, method = c(\"gap_stat\"), k.max = 25, nboot = 500)\n", "\n", "################################################### Clustering #######################################################\n", "\n", "faithful <- as.matrix(read.csv('means_counts_human_DE_stable.csv', header = TRUE, row.names = 1, check.names = FALSE))\n", "df <- zscore(faithful)\n", "# Example: Remove rows with missing values\n", "df <- na.omit(df)\n", "\n", "write.csv(df, file=\"centered_DE_stable_human.csv\")\n", "\n", "pc_dtw <- tsclust(df, k = 3L, seed = 8L, distance = \"sbd\", centroid = \"shape\", preproc = NULL)\n", "\n", "########## Genes in clusters\n", "\n", "row_names <- rownames(df)\n", "\n", "clusters <- slot(pc_dtw, \"cluster\")\n", "\n", "# Create a named vector\n", "named_clusters <- setNames(clusters, row_names)\n", "\n", "# Create a data frame with row names and clusters\n", "cluster_df <- data.frame(row_name = row_names, cluster = clusters)\n", "\n", "new_colnames <- c(\"ID\", \"cluster\")\n", "\n", "# Assign the new column names to the data frame\n", "colnames(cluster_df) <- new_colnames\n", "\n", "# Save the data frame\n", "write.csv(cluster_df, 'clusters_human_stable.csv',row.names = FALSE)\n", "\n", "\n", "########## Number of genes per cluster\n", "\n", "gene_names <- rownames(df)\n", "# Create a data frame with gene names and clusters\n", "gene_cluster_df <- data.frame(Gene = gene_names, Cluster = clusters)\n", "# Calculate the number of genes per cluster\n", "genes_per_cluster <- table(gene_cluster_df$Cluster)\n", "\n", "# Print the results\n", "print(genes_per_cluster)\n", "\n", "genes_per_cluster<-as.data.frame(genes_per_cluster)\n", "\n", "new_colnames <- c(\"cluster\", \"number_of_genes\")\n", "\n", "# Assign the new column names to the data frame\n", "colnames(genes_per_cluster) <- new_colnames\n", "\n", "write.csv(genes_per_cluster, 'genes_per_cluster_stable_human.csv',row.names = FALSE)\n", "\n", "############################################## Plot clusters ##########################################\n", "## In R\n", "\n", "library(reshape2)\n", "library(ggplot2)\n", "library(gmodels)\n", "library(ggalt)\n", "library(knitr)\n", "\n", "options(warn=-1) ### Supresses warnings\n", "\n", "# Get the current working directory\n", "file_directory <- getwd()\n", "\n", "# Get a list of all .txt files in the directory\n", "file_list <- list.files(file_directory, pattern = \"^cluster\", full.names = TRUE)\n", "\n", "# Initialize a list to hold all CI data frames\n", "all_cis <- list()\n", "\n", "# Iterate over the file list\n", "\n", "for (file in file_list) {\n", " tryCatch({\n", " # Read dn.genes from file\n", " df <- as.data.frame(read.csv(file, header = TRUE, row.names = 1, check.names = FALSE))\n", " time<-colnames(df)\n", " time<-as.data.frame(time)\n", " df<-t(df)\n", " suppressWarnings({\n", " cint<-apply(as.matrix(df), 1, function(x) ci(x)) #### Generates mean (estimate), confidence intervales and std error\n", " })\n", "cint<-t(cint)\n", "cint<-as.data.frame(cint)\n", "colnames(cint)<-c(\"Estimate\",\"CI_lower\",\"CI_upper\",\"StdError\")\n", "\n", " # Extract base file name without extension to use as row names\n", "base_file_name <- tools::file_path_sans_ext(basename(file))\n", "\n", "# Add the CI data frame to the list\n", "all_cis[[base_file_name]] <- cint\n", "\n", "\n", "####################### Smooth line\n", "\n", " spline_int <- as.data.frame(spline(as.numeric(rownames(cint)), as.numeric(cint$Estimate)))\n", " spline_lwr <- as.data.frame(spline(as.numeric(rownames(cint)), as.numeric(cint$CI_lower)))\n", " spline_upr <- as.data.frame(spline(as.numeric(rownames(cint)), as.numeric(cint$CI_upper)))\n", " spline_est <-spline_int$y\n", "\n", " gspline <- data.frame(x = spline_int$y,\n", " time = as.numeric(spline_int$x), \n", " fit = spline_est,\n", " lwr = spline_lwr, \n", " upr = spline_upr)\n", "\n", " ps <- ggplot(data = gspline, aes(x = time, y = fit)) + \n", " geom_line(color = \"blue\") +\n", " ylim(-3,3) + geom_hline(yintercept=0, linetype=\"dashed\", color = \"grey\") +\n", " geom_ribbon(aes(ymin = lwr.y, ymax = upr.y), fill = \"lightblue\", alpha = 0.3) +\n", " theme_minimal() +\n", " theme(legend.position = \"none\")\n", "\n", " # Save plot as SVG\n", " svg(file = paste0(file, \"_smooth_progressing_human.svg\"))\n", " print(ps)\n", " dev.off()\n", "\n", " })\n", "}\n", "\n", "# Combine all CI data frames into a single data frame\n", "combined_cis <- do.call(rbind, all_cis)\n", "\n", "# Save the combined data frame to a CSV file\n", "write.csv(combined_cis, \"combined_cis.csv\", row.names = TRUE)\n", "\n", "\n" ] }, { "cell_type": "code", "execution_count": null, "id": "impressive-stand", "metadata": {}, "outputs": [], "source": [ "###################################### GENE SET ENRICHMENT ANALYSIS ######################################################\n", "### In Cytoscape using the ClueGO app. Used for genes present in the different clusters\n", "\n", "##### For Human analysis select:\n", "\n", "# Analysis Mode\n", "ClueGO\n", "# Load Marker List(s)\n", "Homo Sapiens [9606]\n", "# Visual Style\n", "Groups\n", "# ClueGO Settings\n", "GO BiologicalProcess-EBI-UniProt-GOA-ACAP-ARAP\n", "KEGG KEGG-HUMAN-DISEASE\n", "KEGG 25.05.2022\n", "# Global\n", "Show only Pathways with pV <= 0.05\n", "# GO Tree interval\n", "3 # Min Level\n", "8 # Max Level\n", "# GO Term/Pathway Selection (#/% Genes)\n", "# Cluster #1\n", "All #Min #Genes\n", "# GO Term/Pathway Network Connectivity (Kappa Score)\n", "High Score: 0.4\n", "# Advance Statistical Options\n", "Enrichment (Right-sided hypergeometric test) ## for enrichment or :\n", "Depletion (Left-sided hypergeometric test) ## for depletion\n", "Benjamini-Hochberg # pV Correction\n", "# Reference Set options\n", "Selected Ontologies Reference Set\n", "# Grouping Options\n", "# GO Term Grouping (Functional Grouping)\n", "Use GO Term Grouping\n", "# Group coloring\n", "Fix\n", "# Leading Group Term based on\n", "Highest Significance\n", "Tree\n", "3 # Min#Common Parents\n", "4 # Max#Different Parents\n", "\n", "##### For Microbiome analysis select:\n", "\n", "# Analysis Mode\n", "ClueGO\n", "# Load Marker List(s)\n", "oral microbiome [447426]\n", "# Visual Style\n", "Groups\n", "# ClueGO Settings\n", "GO BiologicalProcess-GOA\n", "KEGG\n", "# Global\n", "Show only Pathways with pV <= 0.05\n", "# GO Tree interval\n", "3 # Min Level\n", "8 # Max Level\n", "# GO Term/Pathway Selection (#/% Genes)\n", "# Cluster #1\n", "All #Min #Genes\n", "# GO Term/Pathway Network Connectivity (Kappa Score)\n", "High Score: 0.4\n", "# Advance Statistical Options\n", "Enrichment (Right-sided hypergeometric test) ## for enrichment or :\n", "Depletion (Left-sided hypergeometric test) ## for depletion\n", "Benjamini-Hochberg # pV Correction\n", "# Reference Set options\n", "Selected Ontologies Reference Set\n", "# Grouping Options\n", "# GO Term Grouping (Functional Grouping)\n", "Use GO Term Grouping\n", "# Group coloring\n", "Fix\n", "# Leading Group Term based on\n", "Highest Significance\n", "Tree\n", "3 # Min#Common Parents\n", "4 # Max#Different Parents\n", "####################################################################################################################################\n", "## For the analysis of enrichment in all DE genes:\n", "\n", "################# Gene Ontology (GO) analysis\n", "\n", "library(clusterProfiler)\n", "require(DOSE)\n", "library(stringr)\n", "library(ggridges)\n", "library(ggplot2)\n", "\n", "bkgd.genes<-read.table('bkgd.genes_oral_microbiome.txt', header = FALSE)\n", "\n", "bkgd.genes<-as.character(t(bkgd.genes))\n", "\n", "TERM2GENE<-as.data.frame(read.table('term2gene_go_microbiome.txt', header = FALSE))\n", "\n", "\n", "# Get the current working directory\n", "file_directory <- getwd()\n", "\n", "# Get a list of all .txt files in the directory\n", "file_list <- list.files(file_directory, pattern = \"^RA_\", full.names = TRUE)\n", "\n", "# Iterate over the file list\n", "\n", "for (file in file_list) {\n", " tryCatch({\n", " # Read dn.genes from file\n", " dn.genes <- as.data.frame(read.table(file, header = TRUE))\n", " # we want the log2 fold change \n", " original_gene_list <- dn.genes$log2FoldChange\n", " # name the vector\n", " names(original_gene_list) = as.character(dn.genes[,1])\n", " gene_list <- na.omit(original_gene_list)\n", " # sort the list in decreasing order (required for clusterProfiler)\n", " gene_list = sort(gene_list, decreasing = TRUE)\n", " gc()\n", " gseabp <- clusterProfiler::GSEA(\n", " geneList = gene_list,\n", " minGSSize = 5,\n", " maxGSSize = 300,\n", " pvalueCutoff = 0.05,\n", " pAdjustMethod = \"fdr\",\n", " gson = NULL,\n", " TERM2GENE = TERM2GENE,\n", " TERM2NAME = NA,\n", " verbose = TRUE,\n", " seed = FALSE,\n", " by = \"DOSE\",\n", " nPerm = 10000\n", " )\n", " gc()\n", " # Generate plots\n", " dot <- dotplot(gseabp, split = \".sign\") + facet_grid(. ~ .sign)\n", " network <- cnetplot(gseabp, categorySize = \"pvalue\", color.params = list(foldChange = gene_list), node_label = \"category\", layout = \"kk\")\n", " ridge <- ridgeplot(gseabp) + labs(x = \"enrichment distribution\")\n", "\n", " # Extract the base file name without extension and path\n", " file_base <- basename(file)\n", " # Replace 'RA_cluster' prefix with 'cluster'\n", " output_prefix <- sub(\"^RA_cluster\", \"cluster\", file_base)\n", " \n", " # Save dotplot as SVG\n", " dotplot_file <- paste0(output_prefix, \"_dotplot_GO.svg\")\n", " print(paste(\"Saving dotplot to:\", dotplot_file))\n", " svg(file = dotplot_file)\n", " print(dot)\n", " dev.off()\n", " print(paste(\"Successfully saved dotplot to:\", dotplot_file))\n", "\n", " # Save network as SVG\n", " network_file <- paste0(output_prefix, \"_network_GO.svg\")\n", " print(paste(\"Saving network plot to:\", network_file))\n", " svg(file = network_file)\n", " print(network)\n", " dev.off()\n", " print(paste(\"Successfully saved network plot to:\", network_file))\n", "\n", " # Save ridgeplot as SVG\n", " ridge_file <- paste0(output_prefix, \"_ridge_GO.svg\")\n", " print(paste(\"Saving ridgeplot to:\", ridge_file))\n", " svg(file = ridge_file)\n", " print(ridge)\n", " dev.off()\n", " print(paste(\"Successfully saved ridgeplot to:\", ridge_file))\n", "\n", " # Perform garbage collection\n", " gc()\n", " }, error = function(e) {\n", " cat(\"Error processing file:\", file, \"\\n\")\n", " message(e)\n", " })\n", "}\n", "\n", "save.image(file=\"Results_GO_microbiome.RData\")\n", "\n", "################# KEGG pathways analysis\n", "\n", "library(clusterProfiler)\n", "require(DOSE)\n", "library(stringr)\n", "library(ggridges)\n", "library(ggplot2)\n", "\n", "bkgd.genes<-read.table('bkgd.genes_oral_microbiome.txt', header = FALSE)\n", "\n", "bkgd.genes<-as.character(t(bkgd.genes))\n", "\n", "TERM2GENE<-as.data.frame(read.table('term2gene_kegg_microbiome.txt', header = FALSE))\n", "\n", "\n", "# Get the current working directory\n", "file_directory <- getwd()\n", "\n", "# Get a list of all .txt files in the directory\n", "file_list <- list.files(file_directory, pattern = \"^RA_\", full.names = TRUE)\n", "\n", "# Iterate over the file list\n", "\n", "for (file in file_list) {\n", " tryCatch({\n", " # Read dn.genes from file\n", " dn.genes <- as.data.frame(read.table(file, header = TRUE))\n", " # we want the log2 fold change \n", " original_gene_list <- dn.genes$log2FoldChange\n", " # name the vector\n", " names(original_gene_list) = as.character(dn.genes[,1])\n", " gene_list <- na.omit(original_gene_list)\n", " # sort the list in decreasing order (required for clusterProfiler)\n", " gene_list = sort(gene_list, decreasing = TRUE)\n", " \n", " gseabp <- clusterProfiler::GSEA(\n", " geneList = gene_list,\n", " minGSSize = 50,\n", " maxGSSize = Inf,\n", " pvalueCutoff = 0.05,\n", " pAdjustMethod = \"none\",\n", " gson = NULL,\n", " TERM2GENE = TERM2GENE,\n", " TERM2NAME = NA,\n", " verbose = TRUE,\n", " seed = FALSE,\n", " by = \"DOSE\",\n", " nPerm = 10000\n", " )\n", " \n", " # Generate plots\n", " dot <- dotplot(gseabp, split = \".sign\") + facet_grid(. ~ .sign)\n", " network <- cnetplot(gseabp, categorySize = \"pvalue\", color.params = list(foldChange = gene_list), node_label = \"category\", layout = \"kk\")\n", " ridge <- ridgeplot(gseabp) + labs(x = \"enrichment distribution\")\n", "\n", " # Extract the base file name without extension and path\n", " file_base <- basename(file)\n", " # Replace 'RA_cluster' prefix with 'cluster'\n", " output_prefix <- sub(\"^RA_cluster\", \"cluster\", file_base)\n", " \n", " # Save dotplot as SVG\n", " dotplot_file <- paste0(output_prefix, \"_dotplot_KEGG.svg\")\n", " print(paste(\"Saving dotplot to:\", dotplot_file))\n", " svg(file = dotplot_file)\n", " print(dot)\n", " dev.off()\n", " print(paste(\"Successfully saved dotplot to:\", dotplot_file))\n", "\n", " # Save network as SVG\n", " network_file <- paste0(output_prefix, \"_network_KEGG.svg\")\n", " print(paste(\"Saving network plot to:\", network_file))\n", " svg(file = network_file)\n", " print(network)\n", " dev.off()\n", " print(paste(\"Successfully saved network plot to:\", network_file))\n", "\n", " # Save ridgeplot as SVG\n", " ridge_file <- paste0(output_prefix, \"_ridge_KEGG.svg\")\n", " print(paste(\"Saving ridgeplot to:\", ridge_file))\n", " svg(file = ridge_file)\n", " print(ridge)\n", " dev.off()\n", " print(paste(\"Successfully saved ridgeplot to:\", ridge_file))\n", "\n", " # Perform garbage collection\n", " gc()\n", " }, error = function(e) {\n", " cat(\"Error processing file:\", file, \"\\n\")\n", " message(e)\n", " })\n", "}\n", "\n", "save.image(file=\"Results_kegg_microbiome.RData\")" ] }, { "cell_type": "code", "execution_count": null, "id": "completed-rolling", "metadata": {}, "outputs": [], "source": [ "###################### Figures 4, 5, 6, 7 and S6, S7, S8. Time-lags correlations ########################################\n", "### In R\n", "\n", "library(dynOmics)\n", "\n", "human <- read.table('centered_DE_stable_human.txt', header = TRUE, row.names = 1)\n", "microbiome <- read.table('centered_DE_stable_microbiome.txt', header = TRUE, row.names = 1)\n", "\n", "data_human <-t(human)\n", "data_microbiome <-t(microbiome)\n", "\n", "asso <- associateData(data_human,data_microbiome,numCores = 35)\n", "\n", "summary(asso)\n", "\n", "write.table(asso, file=\"Associations_host-microbiome_stable.txt\", sep=\"\\t\")\n", "\n", "save.image(file='Associations_host-microbiome_stable.RData')\n", "\n", "########### Parse results\n", "\n", "### Remove lines with p-value < 0.05 after FDR correction and with delay=0\n", "\n", "awk '(NR==1) || ($4 != 0 ) && ($6 < 0.05 )' Associations_host-microbiome_stable.txt > Associations_host-microbiome_stable_0.05.txt\n", "\n", "### Remove lines with correlation > 0.95 and < -0.95\n", "\n", "awk '(NR==1) || ($8 > 0.95 ) || ($8 < -0.95 )' Associations_host-microbiome_stable_0.05.txt > Associations_host-microbiome_stable_final.txt\n", "\n", "### Select different delays\n", "\n", "awk '(NR==1) || ($4 == 1 )' Associations_host-microbiome_stable_final.txt > Associations_host-microbiome_stable_delay1.txt\t\n", "awk '(NR==1) || ($4 == -1 )' Associations_host-microbiome_stable_final.txt > Associations_host-microbiome_stable_delay-1.txt\t\n", "\n" ] }, { "cell_type": "code", "execution_count": null, "id": "03a47c3e", "metadata": {}, "outputs": [], "source": [ "################# Figure 8. Causality Analysis using Transfer Entropy: \n", "##In R\n", "\n", "library(dplyr)\n", "library(zoo)\n", "library(vars)\n", "library(lmtest)\n", "library(ggplot2)\n", "library(tidyr)\n", "library(igraph)\n", "library(reshape2)\n", "library(NlinTS)\n", "\n", "# Define a function to extract values from text using regular expressions\n", "extract_value <- function(text, pattern) {\n", " match <- regmatches(text, regexec(pattern, text))\n", " if (length(match[[1]]) > 1) {\n", " return(as.numeric(match[[1]][2]))\n", " } else {\n", " return(NA) # Return NA if no match found\n", " }\n", "}\n", "\n", "# Read the CAL file\n", "CAL <- read.table('CAL_progressing.txt', header = TRUE, check.names = FALSE)\n", "time <- CAL$Time\n", "CAL <- as.data.frame(CAL[, 2])\n", "colnames(CAL) <- \"CAL\"\n", "\n", "# List of cluster file names\n", "cluster_files <- list.files(pattern = \"^series\")\n", "\n", "# Initialize an empty list to store cluster data frames\n", "cluster_means_list <- list()\n", "\n", "# Loop through each cluster file, read the data, calculate column means, and store in the list\n", "for (file in cluster_files) {\n", " cluster_data <- read.table(file, header = TRUE, check.names = FALSE, row.names = 1)\n", " cluster_mean <- as.data.frame(t(colMeans(cluster_data, na.rm = TRUE))) # Transpose to get a single row\n", " colnames(cluster_mean) <- paste(\"Cluster\", 1:ncol(cluster_mean), sep = \"_\") # Standardize column names\n", " cluster_means_list[[file]] <- cluster_mean\n", "}\n", "\n", "# Combine the means into a single data frame\n", "combined_means <- do.call(rbind, cluster_means_list)\n", "combined_means <- t(combined_means) # Transpose back to columns for each series\n", "\n", "# Create the final data frame\n", "ts_data <- data.frame(\n", " time = time,\n", " CAL = CAL,\n", " combined_means\n", ")\n", "\n", "# Rename the columns appropriately\n", "colnames(ts_data)[-c(1, 2)] <- paste0(\"series\", 1:length(cluster_files))\n", "\n", "# Handle missing values\n", "ts_data_imputed <- apply(ts_data, 2, function(column) {\n", " column <- na.locf(column, na.rm = FALSE) # Fill leading NAs with last observation carried forward\n", " column <- na.locf(column, fromLast = TRUE) # Fill trailing NAs with next observation carried backward\n", " na.approx(column, na.rm = FALSE) # Interpolate remaining NAs\n", "})\n", "\n", "# Convert to data frame\n", "ts_data_imputed <- as.data.frame(ts_data_imputed)\n", "\n", "# List of series columns\n", "series_columns <- c(\"CAL\", grep(\"series\", names(ts_data_imputed), value = TRUE))\n", "\n", "# Group by time and calculate the mean for each series column dynamically\n", "data_averaged <- ts_data_imputed %>%\n", " as.data.frame() %>% # Ensure it's a data frame\n", " group_by(time) %>%\n", " summarise(across(all_of(series_columns), ~ mean(.x, na.rm = TRUE)), .groups = \"drop\")\n", "\n", "# Perform transfer entropy analysis for each pair of series columns including CAL\n", "results_df_te <- data.frame(\n", " Series1 = character(),\n", " Series2 = character(),\n", " TE_value = numeric(),\n", " stringsAsFactors = FALSE\n", ")\n", "\n", "for (i in 1:length(series_columns)) {\n", " for (j in 1:length(series_columns)) {\n", " if (i != j) {\n", " ts1 <- data_averaged[[series_columns[i]]]\n", " ts2 <- data_averaged[[series_columns[j]]]\n", " \n", " te_model <- te_cont(ts1, ts2, 1, 1, 3)\n", " \n", " # Append the results to the data frame\n", " results_df_te <- rbind(results_df_te, data.frame(\n", " Series1 = series_columns[i],\n", " Series2 = series_columns[j],\n", " TE_value = te_model\n", " ))\n", " }\n", " }\n", "}\n", "\n", "# View the results\n", "print(results_df_te)\n", "\n", "# Write results to CSV\n", "write.csv(results_df_te, \"nlints_cons_transfer_entropy_results.csv\")\n", "\n", "############################################ Create network ##########################################\n", "\n", "# Assuming `results_df` is your results data frame\n", "# Reshape the data to long format for plotting\n", "data<-results_df_te[,c(1,2,3)]\n", "\n", "colnames(data) <-c(\"var1\",\"var2\",\"value\")\n", "\n", "# Contingency table\n", "table <- xtabs(value ~ var1 + var2, data = data)\n", "\n", "# Convert to matrix (coerces factors to numeric)\n", "matrix_df <- as.matrix(table)\n", "\n", "# Print the matrix\n", "print(matrix_df)\n", "\n", "df<-as.data.frame(matrix_df)\n", "\n", "colnames(df) <-c(\"var1\",\"var2\",\"weigth\")\n", "\n", "g <- graph_from_data_frame(df, directed = TRUE)\n", " \n", "# Add edge weights\n", "E(g)$weight <- df$weigth\n", "\n", "# Check if the graph is weighted\n", "is_weighted(g)\n", "\n", "g2 <- delete_edges(g, which(E(g)$weight>0.05))\n", "\n", "plot(g2)\n", "\n", "write_graph(g2, \"nlints_cons_transfer_entropy_results_progressing.gml\", format = \"gml\")\n", "\n", "#####################################################################################\n", "\n", "# Perform transfer entropy analysis for each pair of series columns including CAL\n", "results_df_te <- data.frame(\n", " Series1 = character(),\n", " Series2 = character(),\n", " TE_value = numeric(),\n", " stringsAsFactors = FALSE\n", ")\n", "\n", "for (i in 1:length(series_columns)) {\n", " for (j in 1:length(series_columns)) {\n", " if (i != j) {\n", " ts1 <- data_averaged[[series_columns[i]]]\n", " ts2 <- data_averaged[[series_columns[j]]]\n", " \n", " te_model <- te_disc(ts1, ts2, 1, 1)\n", " \n", " # Append the results to the data frame\n", " results_df_te <- rbind(results_df_te, data.frame(\n", " Series1 = series_columns[i],\n", " Series2 = series_columns[j],\n", " TE_value = te_model\n", " ))\n", " }\n", " }\n", "}\n", "\n", "\n", "# View the results\n", "print(results_df_te)\n", "\n", "\n", "write.csv(results_df_te, \"nlints_disc_transfer_entropy_results_progressing.csv\")\n", "\n", "save.image(file=\"nlinTS_transfer_entropy_causality.RData\")\n", "\n" ] }, { "cell_type": "code", "execution_count": null, "id": "8541f24b-2a8d-4a85-ad59-4265c499a552", "metadata": {}, "outputs": [], "source": [ "######################### Modeling clusters to explain the clinical outcome\n", "## In R\n", "\n", "library(reshape2)\n", "library(dplyr)\n", "library(ggplot2)\n", "library(keras)\n", "library(reticulate)\n", "library(tidyr)\n", "library(caret)\n", "library(pROC)\n", "\n", "use_python(\"/home/jorgefriaslopez/miniconda3/envs/r-tensorflow38/bin/python\", required = TRUE)\n", "\n", "# Load the annotation data\n", "annotation <- read.table(\"dfAnnotationDESeq2_microbiome.txt\", header = TRUE, row.names =1, check.names = FALSE)\n", "\n", "# Load the gene expression data\n", "gene_expression <- read.table(\"gene_counts_cluster1_progressing_microbiome.tab\",header = TRUE, row.names =1, check.names = FALSE) \n", "\n", "# Convert row names (Geneid) to a column\n", "gene_expression$Geneid <- rownames(gene_expression)\n", "\n", "# Reshape the gene expression data from wide to long format\n", "gene_expression_long <- melt(gene_expression, id.vars = \"Geneid\", variable.name = \"sample\", value.name = \"Expression\")\n", "\n", "# Merge the gene expression data with the annotation data\n", "combined_data <- merge(gene_expression_long, annotation, by = \"sample\", all.x = TRUE)\n", "\n", "# Ensure the data is sorted by subject, time, and Geneid before spreading\n", "combined_data <- combined_data[order(combined_data$subject, combined_data$time, combined_data$Geneid), ]\n", "\n", "# Spread the data to have time points as columns, one row per subject and gene\n", "rnn_data <- combined_data %>%\n", " spread(key = time, value = Expression, fill = 0)\n", "\n", "# Remove any rows with missing values (optional)\n", "rnn_data <- na.omit(rnn_data)\n", "\n", "# Extract unique subject-condition pairs\n", "subject_condition <- combined_data %>% \n", " select(subject, condition) %>% \n", " distinct()\n", "\n", "# Assign labels based on the subject-condition pairs\n", "labels <- subject_condition$condition\n", "labels <- as.numeric(as.factor(labels)) - 1 # Convert to binary: control (0) vs. case (1)\n", "\n", "# Verify the label distribution\n", "table(labels)\n", "\n", "# Determine the dimensions for the RNN input\n", "num_subjects <- nrow(subject_condition) # Should match the number of labels\n", "num_timesteps <- length(unique(combined_data$time))\n", "num_genes <- length(unique(combined_data$Geneid))\n", "\n", "# Reshape to 3D array\n", "rnn_array <- array(\n", " data = as.matrix(rnn_data[, -c(1, 2, 3, 4)]), # Exclude non-numeric columns (subject, Geneid, condition, sample)\n", " dim = c(num_subjects, num_timesteps, num_genes)\n", ")\n", "\n", "# Normalize the gene expression data\n", "max_value <- max(rnn_array, na.rm = TRUE)\n", "if (is.finite(max_value) && max_value > 0) {\n", " rnn_array <- rnn_array / max_value\n", "} else {\n", " stop(\"rnn_array contains no valid values for normalization.\")\n", "}\n", "\n", "#########################################################################\n", "\n", "\n", "# Define the RNN model and give it a unique name\n", "rnn_model <- keras_model_sequential() %>%\n", " layer_lstm(units = 50, input_shape = c(num_timesteps, num_genes)) %>%\n", " layer_dense(units = 1, activation = 'sigmoid')\n", "\n", "\n", "# Compile the model\n", "rnn_model %>% compile(\n", " loss = 'binary_crossentropy',\n", " optimizer = 'adam',\n", " metrics = c('accuracy')\n", ")\n", "\n", "# Train the model using the correct model object 'rnn_model'\n", "history <- rnn_model %>% fit(\n", " rnn_array, labels,\n", " epochs = 100,\n", " batch_size = 32,\n", " validation_split = 0.2\n", ")\n", "\n", "\n", "# Evaluate the model\n", "rnn_model %>% evaluate(rnn_array, labels)\n", "\n", "# Predict and create a confusion matrix\n", "# Generate predictions as probabilities\n", "predictions_prob <- rnn_model %>% predict(rnn_array)\n", "\n", "# Convert probabilities to binary class predictions (0 or 1)\n", "predictions <- ifelse(predictions_prob > 0.5, 1, 0)\n", "\n", "# Create a confusion matrix\n", "table(Predicted = predictions, Actual = labels)\n", "\n", "\n", "# Generate confusion matrix\n", "conf_matrix <- confusionMatrix(factor(predictions), factor(labels))\n", "\n", "# Print the confusion matrix and additional metrics\n", "print(conf_matrix)\n", "\n", "####################################################################################\n", "\n", "# Assuming your trained model is named 'rnn_model'\n", "# Assuming 'rnn_array' contains the input data for which you want predictions\n", "\n", "# Generate predictions as probabilities\n", "predictions_prob1 <- rnn_model %>% predict(rnn_array)\n", "\n", "# Print the predicted probabilities\n", "print(predictions_prob1)\n", "\n", "# Now compute ROC-AUC\n", "roc1 <- roc(labels, predictions_prob1)\n", "\n", "# Plot the ROC curve\n", "plot(roc1, col = \"red\", main = paste(\"ROC Curve (AUC =\", round(auc(roc1), 5), \")\"))\n", "\n", "# Optionally, add additional customization like axis labels or gridlines\n", "grid()\n", "abline(a=0, b=1, col=\"gray\", lty=2) # Adds a diagonal line for reference\n", "\n", "\n", "#####################################################################################################################################\n", "################################# To compare models #################################################################################\n", "\n", "# Convert to numeric vectors if they are matrices\n", "predictions_prob1 <- as.vector(predictions_prob1)\n", "predictions_prob2 <- as.vector(predictions_prob2)\n", "\n", "# Now compute ROC-AUC\n", "roc1 <- roc(labels, predictions_prob1)\n", "roc2 <- roc(labels, predictions_prob2)\n", "\n", "# Print AUC scores\n", "print(auc(roc1))\n", "print(auc(roc2))\n", "\n", "# Optionally, plot ROC curves to visually compare\n", "plot(roc1, col = \"blue\")\n", "plot(roc2, col = \"red\", add = TRUE)\n", "\n", "# Compare the AUCs statistically\n", "roc_test <- roc.test(roc1, roc2)\n", "\n", "# Print the test result\n", "print(roc_test)\n", "\n", "\n", "pred1 <- predictions_prob1 # Binary predictions from model 1\n", "pred2 <- predictions_prob2 # Binary predictions from model 2\n", "\n", "# Make sure predictions are factors with the same levels\n", "pred1 <- factor(pred1, levels = c(0, 1))\n", "pred2 <- factor(pred2, levels = c(0, 1))\n", "\n", "# Create a contingency table\n", "table_comparison <- table(pred1, pred2)\n", "\n", "# Perform McNemar's test\n", "mcnemar_test <- mcnemar.test(table_comparison)\n", "print(mcnemar_test)\n", "\n" ] } ], "metadata": { "kernelspec": { "display_name": "Python 3 (ipykernel)", "language": "python", "name": "python3" }, "language_info": { "codemirror_mode": { "name": "ipython", "version": 3 }, "file_extension": ".py", "mimetype": "text/x-python", "name": "python", "nbconvert_exporter": "python", "pygments_lexer": "ipython3", "version": "3.10.12" } }, "nbformat": 4, "nbformat_minor": 5 }