Plot single block of color in R - r

I am trying to figure out how to plot a single block of color in R. I am trying to visualize a region of a genome with color. I am starting with a matrix that has 1 row and 6049 columns.
l1_canon <- matrix( nrow = 1, ncol = 6049, data = "_" )
Next, I have blocks that differentiate major regions of this element:
l1_canon[,1:909] <- "5' UTR"
l1_canon[,910:1923] <- "ORF1"
l1_canon[,1990:5814] <- "ORF2"
l1_canon[,49:420] <- "CPG"
l1_canon[,5815:6049] <- "3' UTR"
l1_canon[,211:225] <- "RXRA::VDR"
I have assigned colors to the different categories:
l1_colors <- list()
l1_colors[["5' UTR"]] <- "#26A064" # "#ea0064"
l1_colors[["ORF1"]] <- "#3095C7" # "#008a3f"
l1_colors[["ORF2"]] <- "#CA6BAA" # "#116eff"
l1_colors[["CPG"]] <- "#B38241" # "#cf00dc"
l1_colors[["3' UTR"]] <- "#CCCCCC" # "#dddddd"
l1_colors[["RXRA::VDR"]] <- "#FFFFFF"
l1_colors[["_"]] <- "#000000"
But I can't figure out how to plot this. I am looking for something like the color ramp functions in R , and have been trying to adapt the code unsuccessfully.
I tried assigning colors like so
for ( i in l1_canon ){
l1_color <- l1_colors[ l1_canon ]
}
and using it in the code that was used to generate the color ramp plots, but I am getting errors. I am aware that having 6000+ columns is going to make this weird visually, but, it's what I need! I am hoping I can make the individual color blocks small enough to fit on a screen. Eventually, this bar is going to be annotation above another image.
TY for your help! :)

I don't fully understand what you want, but you could use ggplot2 as follows:
# Find the run lengths of the regions
rle1 = rle(l1_canon[1,])
# Turn the run lengths into a data frame
df=data.frame(lengths=rle1$lengths, V=rle1$values)
# Align the colours with the regions
df$color <- unlist(l1_colors)[df$V]
# Plot a single stacked bar on its side with no annotation
ggplot(df, aes(x=1,group=seq_along(V),label=V, fill=color,y=lengths)) +
geom_bar(stat="identity",color="black")+
scale_fill_identity() +
theme_void() +
coord_flip()+
scale_y_reverse()

Related

Is there a way to create a kissing people curve using ggplot2 in R

Is it possible to create custom graphs using ggplot2, for example I want to create a graph of kissing people.
Simple variant
Not completely, but partially, I was able to reproduce it, everything except for the "lines of the eyes" is not clear how to mark them
But how to make a more complex graph of kissing people. In general, is it possible to somehow approximate such a curve, more voluminou?
thank you for your help.
perhaps not what you are looking for, but if you have already got the image, and want to reproduce it in ggplot, then you can use the following method:
library(tidyverse)
library(magick)
library(terra)
# read image
im <- image_read("./data/kiss_1.png")
# conver to black/white image
im2 <- im %>%
image_quantize(
max = 2,
colorspace = "gray" )
# get a matrix of the pixel-colors
m <- as.raster(im2) %>% as.matrix()
# extract coordinates of the black pixels
df <- as.data.frame(which(m == "#000000ff", arr.ind=TRUE))
df$row <- df$row * -1
# plot point
ggplot(df, aes(x = col, y = row)) + geom_point()

In R, how can I tell if the scales on a ggplot object are log or linear?

I have many ggplot objects where I wish to print some text (varies from plot to plot) in the same relative position on each plot, regardless of scale. What I have come up with to make it simple is to
define a rescale function (call it sx) to take the relative position I want and return that position on the plot's x axis.
sx <- function(pct, range=xr){
position <- range[1] + pct*(range[2]-range[1])
}
make the plot without the text (call it plt)
Use the ggplot_build function to find the x scale's range
xr <- ggplot_build(plt)$layout$panel_params[[1]]$x.range
Then add the text to the plot
plt <- plt + annotate("text", x=sx(0.95), ....)
This works well for me, though I'm sure there are other solutions folks have derived. I like the solution because I only need to add one step (step 3) to each plot. And it's a simple modification to the annotate command (x goes to sx(x)).
If someone has a suggestion for a better method I'd like to hear about it. There is one thing about my solution though that gives me a little trouble and I'm asking for a little help:
My problem is that I need a separate function for log scales, (call it lx). It's a bit of a pain because every time I want to change the scale I need to modify the annotate commands (change sx to lx) and occasionally there are many. This could easily be solved in the sx function if there was a way to tell what the type of scale was. For instance, is there a parameter in ggplot_build objects that describe the log/lin nature of the scale? That seems to be the best place to find it (that's where I'm pulling the scale's range) but I've looked and can not figure it out. If there was, then I could add a command to step 3 above to define the scale type, and add a tag to the sx function in step 1. That would save me some tedious work.
So, just to reiterate: does anyone know how to tell the scaling (type of scale: log or linear) of a ggplot object? such as using the ggplot_build command's object?
Suppose we have a list of pre-build plots:
linear <- ggplot(iris, aes(Sepal.Width, Sepal.Length, colour = Species)) +
geom_point()
log <- linear + scale_y_log10()
linear <- ggplot_build(linear)
log <- ggplot_build(log)
plotlist <- list(a = linear, b = log)
We can grab information about their position scales in the following way:
out <- lapply(names(plotlist), function(i) {
# Grab plot, panel parameters and scales
plot <- plotlist[[i]]
params <- plot$layout$panel_params[[1]]
scales <- plot$plot$scales$scales
# Only keep (continuous) position scales
keep <- vapply(scales, function(x) {
inherits(x, "ScaleContinuousPosition")
}, logical(1))
scales <- scales[keep]
# Grab relevant transformations
out <- lapply(scales, function(scale) {
data.frame(position = scale$aesthetics[1],
# And now for the actual question:
transformation = scale$trans$name,
plot = i)
})
out <- do.call(rbind, out)
# Grab relevant ranges
ranges <- params[paste0(out$position, ".range")]
out$min <- sapply(ranges, `[`, 1)
out$max <- sapply(ranges, `[`, 2)
out
})
out <- do.call(rbind, out)
Which will give us:
out
position transformation plot min max
1 x identity a 1.8800000 4.520000
2 y identity a 4.1200000 8.080000
3 y log-10 b 0.6202605 0.910835
4 x identity b 1.8800000 4.520000
Or if you prefer a straightforward answer:
log$plot$scales$scales[[1]]$trans$name
[1] "log-10"

Extracting the exact coordinates of a mouse click in an interactive plot

In short: I'm looking for a way to get the exact coordinates of a series of mouse positions (on-clicks) in an interactive x/y scatter plot rendered by ggplot2 and ggplotly.
I'm aware that plotly (and several other interactive plotting packages for R) can be combined with Shiny, where a box- or lazzo select can return a list of all data points within the selected subspace. This list will be HUGE in most of the datasets I'm analysing, however, and I need to be able to do the analysis reproducibly in an R markdown format (writing a few, mostly less than 5-6, point coordinates is much more readable). Furthermore, I have to know the exact positions of the clicks to be able to extract points within the same polygon of points in a different dataset, so a list of points within the selection in one dataset is not useful.
The grid.locator() function from the grid package does almost what I'm looking for (the one wrapped in fx gglocator), however I hope there is a way to do the same within an interactive plot rendered by plotly (or maybe something else that I don't know of?) as the data sets are often HUGE (see the plot below) and thus being able to zoom in and out interactively is very much appreciated during several iterations of analysis.
Normally I have to rescale the axes several times to simulate zooming in and out which is exhausting when doing it MANY times. As you can see in the plot above, there is a LOT of information in the plots to explore (the plot is about 300MB in memory).
Below is a small reprex of how I'm currently doing it using grid.locator on a static plot:
library(ggplot2)
library(grid)
p <- ggplot(mtcars, aes(wt, mpg)) +
geom_point()
locator <- function(p) {
# Build ggplot object
ggobj <- ggplot_build(p)
# Extract coordinates
xr <- ggobj$layout$panel_ranges[[1]]$x.range
yr <- ggobj$layout$panel_ranges[[1]]$y.range
# Variable for selected points
selection <- data.frame(x = as.numeric(), y = as.numeric())
colnames(selection) <- c(ggobj$plot$mapping$x, ggobj$plot$mapping$y)
# Detect and move to plot area viewport
suppressWarnings(print(ggobj$plot))
panels <- unlist(current.vpTree()) %>%
grep("panel", ., fixed = TRUE, value = TRUE)
p_n <- length(panels)
seekViewport(panels, recording=TRUE)
pushViewport(viewport(width=1, height=1))
# Select point, plot, store and repeat
for (i in 1:10){
tmp <- grid.locator('native')
if (is.null(tmp)) break
grid.points(tmp$x,tmp$y, pch = 16, gp=gpar(cex=0.5, col="darkred"))
selection[i, ] <- as.numeric(tmp)
}
grid.polygon(x= unit(selection[,1], "native"), y= unit(selection[,2], "native"), gp=gpar(fill=NA))
#return a data frame with the coordinates of the selection
return(selection)
}
locator(p)
and from here use the point.in.polygon function to subset the data based on the selection.
A possible solution could be to add, say 100x100, invisible points to the plot and then use the plotly_click feature of event_data() in a Shiny app, but this is not at all ideal.
Thanks in advance for your ideas or solutions, I hope my question was clear enough.
-- Kasper
I used ggplot2. Besides the materials at https://shiny.rstudio.com/articles/plot-interaction.html, I'd like to mention the following:
Firstly, when you create the plot, don't use "print( )" within "renderPlot( )", or the coordinates would be wrong. For instance, if you have the following in UI:
plotOutput("myplot", click = "myclick")
The following in the Server would work:
output$myplot <- renderPlot({
p = ggplot(data = mtcars, aes(x=mpg, y=hp)) + geom_point()
p
})
But the clicking coordinates would be wrong if you do:
output$myplot <- renderPlot({
p = ggplot(data = mtcars, aes(x=mpg, y=hp)) + geom_point()
print(p)
})
Then, you could store the coordinates by adding to the Server:
mydata = reactiveValues(x_values = c(), y_values = c())
observeEvent(input$myclick, {
mydata$x_values = c(mydata$x_values, input$myclick$x)
mydata$y_values = c(mydata$y_values, input$myclick$y)
})
In addition to X-Y coordinates, when you use facet with ggplot2, you refer to the clicked facet panel by
input$myclick$panelvar1

Plot a table with box size changing

Does anyone have an idea how is this kind of chart plotted? It seems like heat map. However, instead of using color, size of each cell is used to indicate the magnitude. I want to plot a figure like this but I don't know how to realize it. Can this be done in R or Matlab?
Try scatter:
scatter(x,y,sz,c,'s','filled');
where x and y are the positions of each square, sz is the size (must be a vector of the same length as x and y), and c is a 3xlength(x) matrix with the color value for each entry. The labels for the plot can be input with set(gcf,properties) or xticklabels:
X=30;
Y=10;
[x,y]=meshgrid(1:X,1:Y);
x=reshape(x,[size(x,1)*size(x,2) 1]);
y=reshape(y,[size(y,1)*size(y,2) 1]);
sz=50;
sz=sz*(1+rand(size(x)));
c=[1*ones(length(x),1) repmat(rand(size(x)),[1 2])];
scatter(x,y,sz,c,'s','filled');
xlab={'ACC';'BLCA';etc}
xticks(1:X)
xticklabels(xlab)
set(get(gca,'XLabel'),'Rotation',90);
ylab={'RAPGEB6';etc}
yticks(1:Y)
yticklabels(ylab)
EDIT: yticks & co are only available for >R2016b, if you don't have a newer version you should use set instead:
set(gca,'XTick',1:X,'XTickLabel',xlab,'XTickLabelRotation',90) %rotation only available for >R2014b
set(gca,'YTick',1:Y,'YTickLabel',ylab)
in R, you should use ggplot2 that allows you to map your values (gene expression in your case?) onto the size variable. Here, I did a simulation that resembles your data structure:
my_data <- matrix(rnorm(8*26,mean=0,sd=1), nrow=8, ncol=26,
dimnames = list(paste0("gene",1:8), LETTERS))
Then, you can process the data frame to be ready for ggplot2 data visualization:
library(reshape)
dat_m <- melt(my_data, varnames = c("gene", "cancer"))
Now, use ggplot2::geom_tile() to map the values onto the size variable. You may update additional features of the plot.
library(ggplot2)
ggplot(data=dat_m, aes(cancer, gene)) +
geom_tile(aes(size=value, fill="red"), color="white") +
scale_fill_discrete(guide=FALSE) + ##hide scale
scale_size_continuous(guide=FALSE) ##hide another scale
In R, corrplotpackage can be used. Specifically, you have to use method = 'square' when creating the plot.
Try this as an example:
library(corrplot)
corrplot(cor(mtcars), method = 'square', col = 'red')

Concentric Circles like a grid, centered at origin

I would like to include a sequence of concentric circles as a grid in a plot of points. The goal is to give the viewer an idea of which points in the plot have approximately the same magnitude.
I created a hack to do this:
add_circle_grid <- function(g,ncirc = 10){
gb <- ggplot_build(g)
xl <- gb$panel$ranges[[1]]$x.range
yl <- gb$panel$ranges[[1]]$y.range
rmax = sqrt(max(xl)^2+max(yl)^2)
theta=seq(from=0,by=.01,to=2*pi)
for(n in 1:ncirc){
r <- n*rmax/ncirc
circle <- data.frame(x=r*sin(theta),y=r*cos(theta))
g<- g+geom_path(data=circle,aes(x=x,y=y),alpha=.2)
}
return(g+xlim(xl)+ylim(yl))
}
xy<-data.frame(x=rnorm(100),y=rnorm(100))
ggplot(xy,aes(x,y))+geom_point()
ggg<-add_circle_grid(ggplot(xy,aes(x,y))+geom_point())
print(ggg)
But I was wondering if there is a more ggplot way to do this. I also considered using polar coordinates but it does not allow me to set x- and y-limits in the same way.
Finally, I wouldn't mind little text labels indicating the radius of each circle.
EDIT
Perhaps this is asking too much but there are two other things that I would like.
The axis limits should stay the same (which can be done via ggplot_build)
Can this work with facets? As far as I can tell you would need to somehow figure out the facets if I want to add the circles dynamically.
set.seed(1)
xy <- data.frame(x=rnorm(100),y=rnorm(100))
rmax = sqrt(max(xy$x)^2+max(xy$y)^2)
theta=seq(from=0,by=.01,to=2*pi)
ncirc=10
dat.circ = do.call(rbind,
lapply(seq_len(ncirc),function(n){
r <- n*rmax/ncirc
data.frame(x=r*sin(theta),y=r*cos(theta),r=round(r,2))
}))
rr <- unique(dat.circ$r)
dat.text=data.frame(x=rr*cos(30),y=rr*sin(30),label=rr)
library(ggplot2)
ggplot(xy,aes(x,y))+
geom_point() +
geom_path(data=dat.circ,alpha=.2,aes(group=factor(r))) +
geom_text(data=dat.text,aes(label=rr),vjust=-1)
How about this with ggplot2 and grid:
require(ggplot2)
require(grid)
x<-(runif(100)-0.5)*4
y<-(runif(100)-0.5)*4
circ_rads<-seq(0.25,2,0.25)
qplot(x,y)+
lapply(circ_rads,FUN=function(x)annotation_custom(circleGrob(gp=gpar(fill="transparent",color="black")),-x,x,-x,x))+
geom_text(aes(x=0,y=circ_rads+0.1,label=circ_rads)) + coord_fixed(ratio = 1)

Resources