## ----setup, include = FALSE--------------------------------------------------- knitr::knit_hooks$set(optipng = knitr::hook_optipng) ## ----load-libs, message = FALSE, warning = FALSE, results = FALSE------------ library(Battlefield) library(SpatialExperiment) library(ggplot2) library(dplyr) library(tidyr) library(pheatmap) library(pals) library(grid) ## ----interfaces1, fig.dim = c(7, 3)------------------------------------------- # Load Visium data data("visium_simulated_spe") df <- data.frame( spot_id = colnames(visium_simulated_spe), x = spatialCoords(visium_simulated_spe)[, 1], y = spatialCoords(visium_simulated_spe)[, 2], cluster = colData(visium_simulated_spe)$cluster ) # Plot cluster distribution ggplot(df, aes(x, y, fill = cluster)) + geom_point(size = 3.2,colour = "grey", shape = 21) + coord_equal() + theme_minimal()+ labs(x = "", y = "") + theme(axis.text = element_blank()) ## ----interfaces2, results='asis'---------------------------------------------- # Detect grid type and get parameters res <- detect_grid_type(df, verbose = FALSE) params <- get_neighborhood_params(df, verbose = FALSE) ## ----interfaces3, fig.dim = c(7, 3)------------------------------------------- border_in <- select_border_spots(df, cluster = 4, interface = 5, mode = "inner", max_dist = 60) # A similar approach would have been # select_border_spots(df, # cluster = 5, # interface = 4, # mode = "outer", # max_dist = 60) knitr::kable(head(border_in)) # Structre data df_in <- df |> mutate(is_border = spot_id %in% border_in$spot_id) |> left_join(border_in |> select(spot_id, is_border_multiple),by = "spot_id") |> mutate(is_border_multiple = coalesce(is_border_multiple, FALSE)) # Plot interface 5 → 4 ggplot(df_in, aes(x, y, fill = cluster)) + geom_point(size = 3.2, shape = 21, colour = "grey") + geom_point(data = subset(df_in, is_border & !is_border_multiple), size = 3.2, colour = "black", fill = NA) + geom_point(data = subset(df_in, is_border & is_border_multiple), size = 3.2, colour = "red", fill = NA) + coord_equal() + theme_minimal()+ labs(x = "", y = "") + theme(axis.text = element_blank()) ## ----interfaces4, fig.dim = c(7, 3)------------------------------------------- all_borders <- build_all_borders(df,max_dist = 60 , k = 6) knitr::kable(head(all_borders)) # Structure data df2 <- df |> left_join(all_borders |> select(spot_id, undirected_pair, is_border_multiple),by = "spot_id") |> mutate(is_border = !is.na(undirected_pair), is_border_multiple = coalesce(is_border_multiple, FALSE)) # Plot all interfaces ggplot(df2, aes(x, y)) + geom_point(data = subset(df2, !is_border), fill="grey" ,colour = "white", size = 3.2,shape = 21) + geom_point(data = subset(df2, is_border & is_border_multiple), aes(color = undirected_pair), size = 3.2, alpha = 0.4) + geom_point(data = subset(df2, is_border & !is_border_multiple), aes(color = undirected_pair), size = 3.2) + coord_equal() + theme_minimal()+ labs(x = "", y = "",color = "") + theme(axis.text = element_blank()) ## ----interfaces5, fig.dim = c(7, 3)------------------------------------------- # Get all pairs and detect grid pairs_visium <- directed_cluster_interface_pairs(df$cluster) params_visium <- get_neighborhood_params(df, verbose = FALSE) # Define cluster pair of interest cluster_A <- 3 cluster_B <- 4 # Build all borders to identify inner spots all_borders_visium <- build_all_borders(df, k = 6, pairs = pairs_visium) # Select border spots for both directions border_A_to_B <- subset(all_borders_visium, cluster == cluster_A & interface == cluster_B ) border_B_to_A <- subset(all_borders_visium, cluster == cluster_B & interface == cluster_A ) # Select inner spots for cluster A inner_A <- select_core_spots(df, all_borders_visium, cluster = cluster_A, interface = cluster_B, mode = "both") # Create visualization dataframe with spot classification df_final <- mutate(df, spot_type=case_when( spot_id %in% border_A_to_B$spot_id ~ "border_A_to_B", spot_id %in% border_B_to_A$spot_id ~ "border_B_to_A", spot_id %in% inner_A$spot_id ~ "inner_A", TRUE ~ "background")) |> as.data.frame() # Plot: clusters with borders and core control spots ggplot(df_final, aes(x, y)) + # 1) Base clusters fill="gray" ,colour = "grey", size = 3.2,shape = 21) + # nolint: line_length_linter. geom_point(aes(color = cluster), size = 2.5) + # 2) Draw outlines (slightly larger) so they "surround" without hiding geom_point(data = subset(df_final, spot_type == "border_A_to_B"), color = "blue", size = 2.5, shape = 1, stroke = 1.25) + geom_point(data = subset(df_final, spot_type == "border_B_to_A"), color = "red", size = 2.5, shape = 1, stroke = 1.25) + geom_point(data = subset(df_final, spot_type == "inner_A"), color = "black", size = 2.5, shape = 1, stroke = 1.25) + # 3) Re-draw the colored points ON TOP for the highlighted subset geom_point( data = subset(df_final, spot_type %in% c("border_A_to_B", "border_B_to_A", "inner_A")), aes(color = cluster), size = 2.5 ) + coord_equal() + theme_minimal() + labs(x = "", y = "",color = "") + theme(axis.text = element_blank()) ## ----layers1,fig.dim = c(7,3)------------------------------------------------- target_cluster <- 3 # Narrow intermediate layer layers_df <- create_cluster_layers(df, target_cluster = target_cluster, intermediate_quantile = 0.33) # Create visualization dataframe df_viz <- df |> mutate(layer = NA_character_) |> as.data.frame() # Map layers to the full dataset idx_match <- match(layers_df$spot_id, df_viz$spot_id) valid_idx <- !is.na(idx_match) df_viz$layer[idx_match[valid_idx]] <- layers_df$layer[valid_idx] # Create combined plot: clusters in background + layers overlay with circles ggplot(df_viz, aes(x, y)) + # base clusters geom_point(aes(color = cluster), size = 2.5) + # 2) Draw outlines (slightly larger) so they "surround" without hiding geom_point( data = subset(df_viz, layer == "core"), shape = 1, color = "#DDDDDD", size = 3.2, stroke = 1.25 ) + geom_point( data = subset(df_viz, layer == "intermediate"), shape = 1, color = "#666666", size = 3.2, stroke = 1.25 ) + geom_point( data = subset(df_viz, layer == "border"), shape = 1, color ="black", size = 3.2, stroke = 1.25 ) + # 3) Re-draw the colored points ON TOP for the highlighted subset geom_point( data = subset(df_viz, layer %in% c("core", "intermediate", "border")), aes(color = cluster), size = 2.5 ) + coord_equal() + theme_minimal()+ labs( x = "", y = "", color = "" ) + theme( axis.text = element_blank() ) ## ----trajectories1,fig.dim = c(7,3)------------------------------------------- # We retrieve expression for later visualization expr <- as.numeric(assay(visium_simulated_spe, "counts")["FAKE_GENE", ]) test <- cbind(as.data.frame(colData(visium_simulated_spe)), df[, c("x", "y"), drop = FALSE]) test$expr <- expr start_cluster <- "3" end_cluster <- "4" top_n <- 8 centroids <- compute_centroids(df) A <- centroids[centroids$cluster == start_cluster, c("x","y")] B <- centroids[centroids$cluster == end_cluster, c("x","y")] res <- build_one_trajectory(df, A, B, top_n = top_n, max_dist = NULL) knitr::kable(head(res)) # Plot cluster distribution ggplot(test, aes(x, y, fill = cluster)) + geom_point(size = 3.2,colour="grey", shape = 21) + geom_path(data=res, aes(x=x, y=y, group=trajectory_id), color="black",linewidth=2) + geom_point(data = res, aes(x, y), size = 3.2, fill="red",colour="black", shape = 21) + coord_equal() + theme_minimal() + labs(x = "", y = "") + theme(axis.text = element_blank()) ## ----trajectories2, fig.dim = c(7,3)------------------------------------------ out <- build_similar_trajectories(df, A, B, top_n = top_n, n_extra = 2, lane_width_factor = 2.5, side = "both") knitr::kable(head(out)) ggplot(test, aes(x, y)) + geom_point(aes(color = expr),size = 1.6, alpha = 0.85) + scale_color_gradient(low = "blue",high = "red") + geom_path(data=out, aes(x=x, y=y, group=trajectory_id), inherit.aes = FALSE, color="black",linewidth=1, arrow = grid::arrow(type = "closed", length = grid::unit(2, "mm"))) + geom_point(data = out, aes(x, y), inherit.aes = FALSE, size = 2.2, fill="white",color="black") + coord_equal() + theme_minimal() + labs(x = "", y = "") + theme(axis.text = element_blank()) ## ----trajectories3, fig.dim = c(7,3)------------------------------------------ meta <- out|> transmute( spot_id = as.character(spot_id), trajectory = as.character(trajectory_id), progress = as.numeric(pos_on_seg) ) |> group_by(trajectory) |> arrange(progress, .by_group = TRUE) |> mutate( index = seq_len(n()) # <- index 1..length ordered according to t ) |> ungroup() gene <- c("FAKE_GENE") expr <- assay(visium_simulated_spe, "counts")[gene, meta$spot_id] meta$expr <- expr mat <- meta |> select(trajectory, index, expr) |> tidyr::pivot_wider(names_from = index, values_from = expr) |> as.data.frame() rownames(mat) <- mat$trajectory mat$trajectory <- NULL pheatmap( mat, cluster_rows = FALSE, cluster_cols = FALSE, border_color = "white", main = gene,angle_col=0, col=pals::coolwarm(), scale="row", cellwidth=25, cellheight=25 , na_col = "grey90" ) ## ----neighborhood1------------------------------------------------------------ # Getting neighborhoods... neighborhood_spots_1 <- get_neighborhood_spots(df, cluster = 1, k = 200) head(neighborhood_spots_1) # Counting the clusters in the neighborhoods... neighb_vis <- count_neighborhood(df, cluster = 1, k = 100) head(neighb_vis) ## ----neighborhood2, fig.dim = c(7,3)------------------------------------------ neighb_vis <- count_all_neighborhoods(df, k = 100) # Add inlaid column with random values (5 categories) df$inlaid <- sample(paste0("inlaid", 1:5), nrow(df), replace = TRUE) df_neighborhood_viz <- df |> mutate( spot_type = "background", spot_type = ifelse(cluster == 1, "source", spot_type), spot_type = ifelse(spot_id %in% neighborhood_spots_1$spot_id, "neighborhood", spot_type) ) |> as.data.frame() # Apply the same cluster factor levels as df_vis df_neighborhood_viz$cluster <- factor(df_neighborhood_viz$cluster, levels = sort(unique(df$cluster))) ggplot(df_neighborhood_viz, aes(x, y)) + geom_point( data = subset(df_neighborhood_viz, spot_type == "neighborhood"), shape = 1, color = "grey", size = 3.2, stroke = 1.25 ) + geom_point( aes(color = cluster), size = 2.5 ) + geom_point( data = subset(df_neighborhood_viz, inlaid == "inlaid1"), fill = "black", size = 2.5 ) + coord_equal() + theme_minimal() + labs(x = "", y = "") + theme(axis.text = element_blank() ) # Counting the black point -inlaid spots- in the neighborhood of cluster 1 neighb_vis <- count_neighborhood(df, cluster = 1, inlaid_col = "inlaid",k = 100) head(neighb_vis) ## ----neighborhood3,eval=TRUE-------------------------------------------------- # === Testing get_inlaid_spots inlaid_spots_1 <- get_inlaid_spots(df, cluster = 1, inlaid_col = "inlaid") # === Testing count_inlaid === inlaid_1 <- count_inlaid(df, cluster = 1, inlaid_col = "inlaid") # === Testing count_all_inlaids === all_inlaids <- count_all_inlaids(df, inlaid_col = "inlaid") knitr::kable(head(all_inlaids, 15)) ## ----integration1------------------------------------------------------------- visium_simulated_spe <- add_borders_to_spe(visium_simulated_spe, border = all_borders) visium_simulated_spe <- add_layers_to_spe(visium_simulated_spe, layer = layers_df) visium_simulated_spe <- add_trajectories_to_spe(visium_simulated_spe, trajectory = out) # View the annotated colData head(colData(visium_simulated_spe)) ## ----session-info------------------------------------------------------------- sessionInfo()