ggsector

In ggsector: Draw Sectors

knitr::opts_chunk$set(
    tidy = FALSE,
    collapse = TRUE,
    comment = "#>",
    fig.width = 5,
    fig.height = 4
)

Load the required R packages.

##library
library(magrittr)
library(grid)
library(Seurat)
library(ggplot2)
library(ggsector)

Use original coordinates with grid.polygon

coordinates of single sector

type of percent, start = 0, r_start = 0

tmp_df <- sector_df(x = 0.5, y = 0.5, theta = 25, r = 0.4, start = 0, r_start = 0)
head(tmp_df)
grid.newpage()
grid.polygon(
    tmp_df$x, tmp_df$y,
    vp = viewport(height = unit(1, "snpc"), width = unit(1, "snpc"))
)

type of percent, start = 50, r_start = 0.2

tmp_df <- sector_df(x = 0.5, y = 0.5, theta = 25, r = 0.4, start = 50, r_start = 0.2)
head(tmp_df)
grid.newpage()
grid.polygon(
    tmp_df$x, tmp_df$y,
    vp = viewport(height = unit(1, "snpc"), width = unit(1, "snpc"))
)

type of degree, start = 90, r_start = 0

tmp_df <- sector_df(
    x = 0.5, y = 0.5, theta = 180, r = 0.4,
    start = 90, r_start = 0, type = "degree"
)
head(tmp_df)
grid.newpage()
grid.polygon(
    tmp_df$x, tmp_df$y,
    vp = viewport(height = unit(1, "snpc"), width = unit(1, "snpc"))
)

type of degree, start = 180, r_start = 0.2

tmp_df <- sector_df(
    x = 0.5, y = 0.5, theta = 180, r = 0.4,
    start = 270, r_start = 0.2, type = "degree"
)
head(tmp_df)
grid.newpage()
grid.polygon(
    tmp_df$x, tmp_df$y,
    vp = viewport(height = unit(1, "snpc"), width = unit(1, "snpc"))
)

Coordinates of Multiple Sectors

tmp_df <- sector_df_multiple(
    x = c(0.2, 0.5, 0.8),
    theta = c(25, 50, 75),
    r = 0.15,
    start = c(75, 50, 100),
    r_start = c(0, 0.05, 0.1),
    type = "percent"
)
head(tmp_df)
grid.newpage()
grid.polygon(
    tmp_df$x,
    tmp_df$y,
    id = tmp_df$group,
    vp = viewport(height = unit(1, "snpc"), width = unit(1, "snpc")),
    gp = gpar(
        fill = 3:1, col = 1:3
    )
)

Use ggsector with grid

sectorGrob

sectorGrob with units of "cm" and type of "degree"

grid.newpage()
gp <- sectorGrob(
    x = unit(c(3, 5, 7), "cm"),
    y = unit(c(3, 5, 7), "cm"),
    theta = c(90, 180, 270),
    r = 1,
    start = c(180, 180, 270),
    r_start = c(0.6, 0.3, 0),
    type = "degree",
    group = factor(1:3, levels = c(2, 3, 1)),
    gp = gpar(fill = c("green", "red", "blue"))
)
grid.draw(gp)

grid.sector

grid.sector with units of "npc" and type of "percent"

grid.newpage()
grid.sector(
    x = c(0.1, 0.5, 0.9),
    y = c(0.9, 0.6, 0.1),
    theta = c(25, 50, 90),
    r = .1,
    start = c(25, 50, 100),
    r_start = c(0.06, 0.03, 0),
    type = "percent",
    group = factor(1:3, levels = c(2, 3, 1)),
    gp = gpar(col = c("green", "red", "blue"), fill = 2:4),
    default.units = "npc"
)

Use ggsector with ComplexHeatmap

Prepare data

## install ComplexHeatmap
# if (!require("ComplexHeatmap", quietly = TRUE)) {
#     if (!require("BiocManager", quietly = TRUE)) {
#         install.packages("BiocManager")
#     }
#     BiocManager::install("ComplexHeatmap")
# }

## run
library(magrittr)
library(ComplexHeatmap)

t0 <- cor(mtcars) %>%
    set_colnames(paste("y_", colnames(.))) %>%
    set_rownames(paste("x_", rownames(.)))
mat <- abs(t0)
mat[1:5, 1:5]

cell_fun + viewport

Realized by modifying the [grid::viewport()] with cell_fun, the sector can be set with a fixed width and height

set.seed(1)
Heatmap(
    mat,
    name = "vp",
    rect_gp = gpar(type = "none"),
    cell_fun = function(j, i, x, y, width, height, fill) {
        grid.rect(
            x = x, y = y, width = width, height = height,
            gp = gpar(col = "grey", fill = NA)
        )
        grid.sector(
            theta = mat[i, j] * 100,
            r = 0.5,
            start = mat[i, j] * 100 * runif(1),
            r_start = mat[i, j] * 0.49 * runif(1),
            vp = viewport(x, y, width, height),
            gp = gpar(fill = fill, col = "transparent")
        )
    },
    width = unit(.7, "snpc"),
    height = unit(.7, "snpc")
)

cell_fun + xy

Realized in the form of coordinates + radius with cell_fun.

# The default viewport locks the horizontal and vertical axes
# so that the sector does not deform, which needs to be removed here.
# The radius 'r' is half the min(length, width).
set.seed(2)
Heatmap(
    mat,
    name = "xy + r",
    rect_gp = gpar(type = "none"),
    cell_fun = function(j, i, x, y, width, height, fill) {
        grid.rect(
            x = x, y = y, width = width, height = height,
            gp = gpar(col = "grey", fill = NA)
        )
        r <- as.numeric(min(width, height)) / 2
        grid.sector(
            x,
            y,
            theta = mat[i, j] * 100,
            r = r,
            start = mat[i, j] * 100 * runif(1),
            r_start = mat[i, j] * r * 0.9 * runif(1),
            vp = NULL,
            gp = gpar(fill = fill, col = "transparent")
        )
    },
    width = unit(.7, "snpc"),
    height = unit(.7, "snpc")
)

layer_fun + xy

Realized With layer fun

# The input matrix needs to be extracted with pindex(mat, i, j)
set.seed(3)
Heatmap(
    mat,
    name = "layer",
    rect_gp = gpar(type = "none"),
    layer_fun = function(j, i, x, y, width, height, fill) {
        grid.rect(
            x = x, y = y, width = width, height = height,
            gp = gpar(col = "grey", fill = NA)
        )
        r <- as.numeric(min(width, height)) / 2
        grid.sector(
            x,
            y,
            theta = pindex(mat, i, j) * 100,
            r = r,
            start = pindex(mat, i, j) * 100 * runif(nrow(mat) * ncol(mat)),
            r_start = pindex(mat, i, j) * r * 0.9 * runif(nrow(mat) * ncol(mat)),
            vp = NULL,
            gp = gpar(fill = fill, col = "transparent")
        )
    },
    width = unit(.7, "snpc"),
    height = unit(.7, "snpc")
)

Use ggsector with ggplot2

prepare data

library(ggsector)
library(reshape2)
df <- cor(mtcars)[1:3, 1:5] %>%
    abs() %>%
    melt(varnames = c("x", "y"))
## Note, for better display effect, please always add coord_fixed()
## Note, for better display effect, please always add coord_fixed()
## Note, for better display effect, please always add coord_fixed()

theta

The sector angle parameter, used in combination with the type parameter, the type parameter defaults to "percent".
When type = "percent", the complete circle is a polygon composed of 100 scattered points, and theta takes a value of 0-100.
When type = "degree", the complete circle is a polygon composed of 360 scattered points, and theta takes a value of 0-360.

ggplot(df) +
    ## type = "percent", theta = 0-100
    geom_sector(
        aes(y, x, theta = value * 100),
        type = "percent",
        color = "blue",
        individual = TRUE
    ) +
    ## type = "degree", theta = 0-360
    geom_sector(
        aes(y, x, theta = value * 360),
        type = "degree",
        color = "red",
        alpha = 0.5,
        individual = TRUE
    ) +
    coord_fixed() +
    theme_bw() +
    theme(axis.title = element_blank())

Careful observation reveals:

The sectors shapes in the two modes are not completely overlapped, this is because:
when type = "percent", the circumference is 100 scattered points, and the input value will be round() to an integer of 0-100,
when type = "degree", the circumference is 360 scattered points, and the input value will be round() to an integer of 0-360.
The more circle points, the higher the precision, but also means the slower drawing speed.

r

Radius of the outer circle of the sector(0-0.5)

ggplot(df) +
    geom_sector(
        aes(y, x, theta = value * 100),
        r = rep(c(0.15, 0.3, 0.45), 5),
        fill = 2,
        individual = TRUE
    ) +
    coord_fixed() +
    theme_bw() +
    theme(axis.title = element_blank())

start

Starting angle of sector.

ggplot(df) +
    geom_sector(
        aes(y, x, theta = value * 100),
        start = rep(c(60, 40, 20), 5),
        fill = 2,
        individual = TRUE
    ) +
    coord_fixed() +
    theme_bw() +
    theme(axis.title = element_blank())

r_start

The starting position parameter of the fan radius, the value is between 0 and the radius length, and the default is 0, which means drawing a fan shape. If it is greater than 0, it is to draw a sector, and the following are different displays

ggplot(df) +
    geom_sector(
        aes(y, x, theta = value * 100),
        r_start = rep(c(0.15, 0.25, 0.35), 5),
        fill = 2,
        individual = TRUE
    ) +
    coord_fixed() +
    theme_bw() +
    theme(axis.title = element_blank())

individual

The default is FALSE, mainly to control whether to draw sector by sector with a single coordinate point or to draw as a whole on the drawing board in the form of vector.
When individual = TRUE, draw one by one, the sector will not be deformed, but when there are too many sectors drawn, the overall drawing speed will be much slower.
When individual = FALSE, drawing in vector form is faster, but it needs to be used with coord_fixed() or ratio to lock the aspect ratio of the drawing board, otherwise the sector will be deformed.

individual with coord_fixed()

For better display effect, please always add coord_fixed().

individual = TRUE + coord_fixed()

# x = x, y = y
ggplot(rbind(
    cbind(df, t1 = 1),
    cbind(df[1:9, ], t1 = 2)
)) +
    facet_wrap(~t1, ncol = 2) +
    geom_sector(
        aes(x, y),
        theta = 75,
        fill = 2,
        r = 0.5,
        individual = TRUE
    ) +
    coord_fixed() +
    theme_bw() +
    theme(axis.title = element_blank())

# x = y, y =x
ggplot(rbind(
    cbind(df, t1 = 1),
    cbind(df[1:9, ], t1 = 2)
)) +
    facet_wrap(~t1, ncol = 2) +
    geom_sector(
        aes(y, x),
        theta = 75,
        fill = 2,
        r = 0.5,
        individual = TRUE
    ) +
    coord_fixed() +
    theme_bw() +
    theme(axis.title = element_blank())

individual = FALSE + coord_fixed()

# x = x, y = y
ggplot(rbind(
    cbind(df, t1 = 1),
    cbind(df[1:9, ], t1 = 2)
)) +
    facet_wrap(~t1, ncol = 2) +
    geom_sector(
        aes(x, y),
        theta = 75,
        fill = 2,
        r = 0.5,
        individual = FALSE
    ) +
    coord_fixed() +
    theme_bw() +
    theme(axis.title = element_blank())

# x = y, y =x
ggplot(rbind(
    cbind(df, t1 = 1),
    cbind(df[1:9, ], t1 = 2)
)) +
    facet_wrap(~t1, ncol = 2) +
    geom_sector(
        aes(y, x),
        theta = 75,
        fill = 2,
        r = 0.5,
        individual = TRUE
    ) +
    coord_fixed() +
    theme_bw() +
    theme(axis.title = element_blank())

individual without coord_fixed()

individual = TRUE without coord_fixed()

If you are in a special situation and cannot use coord_fixed(), then it is recommended that you use individual = TRUE and the r parameter to fine-tune. Also, to reduce the radius, you need to try it manually.

# x = x, y = y
ggplot(rbind(
    cbind(df, t1 = 1),
    cbind(df[1:9, ], t1 = 2)
)) +
    facet_wrap(~t1, ncol = 2) +
    geom_sector(
        aes(x, y),
        theta = 75,
        fill = 2,
        r = 0.35, ## To reduce the radius, you need to try it manually
        individual = TRUE
    ) +
    theme_bw() +
    theme(axis.title = element_blank())

# x = y, y =x
ggplot(rbind(
    cbind(df, t1 = 1),
    cbind(df[1:9, ], t1 = 2)
)) +
    facet_wrap(~t1, ncol = 2) +
    geom_sector(
        aes(y, x),
        theta = 75,
        fill = 2,
        r = 0.25, ## To reduce the radius, you need to try it manually
        individual = TRUE
    ) +
    theme_bw() +
    theme(axis.title = element_blank())

individual = FALSE without coord_fixed()

If you really want to use individual = FALSE without coord_fixed(), you might try the experimental parameter ratio' You need to manually adjust theratio` value to prevent sector deformation.

# x = x, y = y
ggplot(rbind(
    cbind(df, t1 = 1),
    cbind(df[1:9, ], t1 = 2)
)) +
    facet_wrap(~t1, ncol = 2) +
    geom_sector(
        aes(x, y),
        theta = 75,
        fill = 2,
        r = 0.5,
        ## You need to manually adjust the `ratio` value
        ## to prevent sector deformation.
        ratio = 1.6,
        individual = FALSE
    ) +
    theme_bw() +
    theme(axis.title = element_blank())

# x = y, y =x
ggplot(rbind(
    cbind(df, t1 = 1),
    cbind(df[1:9, ], t1 = 2)
)) +
    facet_wrap(~t1, ncol = 2) +
    geom_sector(
        aes(y, x),
        theta = 75,
        fill = 2,
        r = 0.5,
        ## You need to manually adjust the `ratio` value
        ## to prevent sector deformation.
        ratio = 1.6,
        individual = FALSE
    ) +
    # coord_fixed() +
    theme_bw() +
    theme(axis.title = element_blank())

Use ggsector with Seurat

Due to the large raw data of "pbmc", only the code is shown here, but not run.

Readers are invited to download the data and try it out.

## Download pbmc data from
# https://cf.10xgenomics.com/samples/cell/pbmc3k/pbmc3k_filtered_gene_bc_matrices.tar.gz
library(Seurat)
path <- paste0(tempdir(), "/pbmc3k.tar.gz")
file <- paste0(tempdir(), "/filtered_gene_bc_matrices/hg19")
download.file(
    "https://cf.10xgenomics.com/samples/cell/pbmc3k/pbmc3k_filtered_gene_bc_matrices.tar.gz",
    path
)
untar(path, exdir = tempdir())
pbmc.data <- Read10X(data.dir = file)
pbmc <- CreateSeuratObject(
    counts = pbmc.data, project = "pbmc3k",
    min.cells = 3, min.features = 200
)
pbmc <- NormalizeData(pbmc)
pbmc <- FindVariableFeatures(pbmc, selection.method = "vst", nfeatures = 2000)
pbmc <- ScaleData(pbmc, features = rownames(pbmc))
pbmc <- RunPCA(pbmc)
pbmc <- RunUMAP(pbmc, dim = 1:10)
pbmc <- FindNeighbors(pbmc, dims = 1:10)
pbmc <- FindClusters(pbmc, resolution = 1)
pbmc <- FindClusters(pbmc, resolution = 0.5)
markers <- tibble::tribble(
    ~type, ~marker,
    "Naive CD4+ T", "IL7R,CCR7",
    "CD14+ Mono", "CD14,LYZ",
    "Memory CD4+", "IL7R,S100A4",
    "B", "MS4A1",
    "CD8+ T", "CD8A",
    "FCGR3A+ Mono", "FCGR3A,MS4A7",
    "NK", "GNLY,NKG7",
    "DC", "FCER1A,CST3",
    "Platelet", "PPBP",
) %>%
    tidyr::separate_rows(marker, sep = ", *") %>%
    dplyr::distinct()

# Dotplot
DotPlot(pbmc, features = unique(markers$marker)) + coord_flip()

# contrast with DotPlot
SectorPlot(pbmc, markers$marker, features.level = unique(rev(markers$marker)))

SectorPlot(pbmc, markers$marker, group.by = "RNA_snn_res.1")
SectorPlot(pbmc, markers$marker, group.by = "RNA_snn_res.1", slot = "scale.data")

# split plot
# Assume a variable 'day', expressed as the number of days of cell development.
set.seed(1)
pbmc[["day"]] <- sample(1:3, ncol(pbmc), TRUE)
SectorPlot(pbmc, markers$marker, group.by = "RNA_snn_res.0.5", split.by = "day")
SectorPlot(
    pbmc, markers$marker,
    group.by = "day", split.by = "RNA_snn_res.0.5", nrow = 1
)

ggsector documentation built on Oct. 31, 2024, 9:06 a.m.