I need to plot a heatmap using axis ordered as is in table.
My data is is csv format:
"X" "Mescla" "HCL" "HSL" "Kmeans" "soma"
"1" "DR" 15.33559 14.7499 14.7556 14.32343 89.78054
"2" "DA" 16.59264 14.764 14.9968 14.36513 91.08672
"3" "UMR80" 16.28646 15.88403 14.01783 15.96327 94.55977
"4" "UMR" 16.46229 15.87505 14.34763 15.87903 94.83926
"5" "MR50" 16.61305 16.04243 14.85003 16.15599 96.20576
> data
X merge A1 A2 K sum
1 DR 15.33559 14.74990 14.75560 14.32343 89.78054
2 DA 16.59264 14.76400 14.99680 14.36513 91.08672
3 UMR80 16.28646 15.88403 14.01783 15.96327 94.55977
4 UMR 16.46229 15.87505 14.34763 15.87903 94.83926
5 MR50 16.61305 16.04243 14.85003 16.15599 96.20576
My solution is to use arguments Rowv=FALSE and Colv=FALSE:
library(gplots)
library(RColorBrewer)
rnames <- data[,1]
mat_data <- data.matrix(data[,3:ncol(data)-1])
rownames(mat_data) <- rnames
my_palette <- colorRampPalette(c("red", "yellow", "green"))(n = 299)
col_breaks = c(seq(-1,0,length=100), # for red
seq(0,0.8,length=100), # for yellow
seq(0.81,1,length=100)) # for green
heatmap.2(mat_data,
main = "Rank", # heat map title
notecol="black", # change font color of cell labels to black
density.info="none", # turns off density plot inside color legend
trace="none", # turns off trace lines inside the heat map
margins =c(7,5), # widens margins around plot
col=my_palette, # use on color palette defined earlier
Rowv=FALSE,
Colv=FALSE,
dendrogram="none") # turn off column clustering
The heatmap is:
Related
I need a gradient function for two "sides", let me explain:
Example:
x <- c(1,4,3,4,5,6,1,8,9,3)
then I need a array of color, the number 5 is the main color blue and the smaller and larger numbers are the gradient to red.
I found this
colorRampPalette(c("red", "blue"))
but if I do:
colfunc <- colorRampPalette(c("red", "blue"))
colfunc(10)
Returns a color progression from red to blue ignoring the value...
How can I do this?
Ps: I don't use any library...
For share with the community,
using the function "colorRampPalette", like:
col <- colorRampPalette(c('red', 'blue','red'))(10)[y]
where 10 is the range 1:10 with extremities red and in middle (5) in blue and other values are the gradient going to red.
in an example,
size <- 30 #number of value in the data vector
x <- c(1:size)
y <- c(1 ,2 ,3.5,3 ,4,
5 ,5.5,6 ,6.3,7,
5 ,2 ,1 ,0.5,1.6,
2.3,5.7,6 ,7 ,7.5,
8 ,9 ,11 ,12 ,10,
7 ,6.4,5 ,4.6 ,4)
col <- colorRampPalette(c('red', 'blue','red'))(12)[y]
plot(x, y) # draw the points, in black
for (i in 1:size-1) # draw the segments in colour
lines(x[i:(i+1)], y[i:(i+1)], type='o', pch=16, col=col[i])
I have a data frame of the form
> geneRows[1:3,]
Probe/gene logFC CI.L CI.R AveExpr t P.Value adj.P.Val
17656 220307_at -0.09017596 -0.4395575 0.25920561 6.104288 -0.5992736 0.5662047 1
37517 220307_at 0.08704844 -0.2613434 0.43544028 6.104288 0.5801327 0.5784053 1
57376 220307_at -0.03501474 -0.1267764 0.05674688 6.152467 -0.7816350 0.4409881 1
B gene GSE Group1 Group2 shape color
17656 -5.639256 CD244 GSE2461 Male Female x-open black
37517 -5.978691 CD244 GSE2461 ulcerative colitis irritable bowel syndrome x-open black
57376 -5.141940 CD244 GSE27887 nonlesional skin lesional skin x-open black
I want to subset this so that I can get at the CI.R column when the CI.L column is a certain value. For example, I've tried
geneRows$CI.R[geneRows$CI.L == -0.4395575]
but I get back numeric(0), meaning an empty vector. However when I try it on a sample dataset, something like
mtcars$mpg[mtcars$carb==8]
it works just fine. They are the same data types and everything, so what's the issue here?
Background
I am creating lines to be added to a plotly plot.
line <- list(
type = "line",
line = list(color = "grey"),
width = 0.2,
xref = "x",
yref = "y"
)
lines <- list()
for (i in geneRows$CI.L) {
line[["x0"]] <- i
line[["x1"]] <- #here
lines <- c(lines, list(line))
}
They need to be drawn from CI.L to CI.R for each line. I am trying to get the end point x1 from the table via the start point.
Your numbers might have more precision than is being printed. For example:
> -0.4395575 == -0.4395575
[1] TRUE
> -0.4395575 == -0.4395575001
[1] FALSE
You could instead use all.equal which by default has a tolerance of 1.5e-8 but can be adjusted.
> all.equal(-0.4395575, -0.4395575001)
[1] TRUE
> all.equal(-0.4395575, -0.4395575001, tolerance = 1e-10)
[1] "Mean relative difference: 2.275015e-10"
Can I specify endpoints to colorRamp so that a value maps consistently to a single color, regardless of the range of other data?
I'm trying to create an interactive correlation plot in plotly. Here's some sample data.
set.seed(1)
m <- 4
cm <- matrix(runif(m**2,-1,1),
nrow=m, ncol=m,
dimnames=list(letters[1:m],letters[1:m]))
diag(cm) <- 1
cm
# a b c d
# a 1.0000000 -0.5966361 0.2582281 0.3740457
# b -0.2557522 1.0000000 -0.8764275 -0.2317926
# c 0.1457067 0.8893505 1.0000000 0.5396828
# d 0.8164156 0.3215956 -0.6468865 1.0000000
I'm basically trying to create an interactive version of this:
library(corrplot)
corrplot(cm,method='shade')
Here's the (kind of hacky) interactive correlation plot I created.
div_colors <- c('dark red','white','navy blue')
grid_labels <- matrix(paste0('Cor(',
do.call(paste,c(expand.grid(rownames(cm),colnames(cm)), sep=', ') ),
'): ',
t(round(cm,2))
),
ncol=m,byrow=TRUE)
library(plotly)
plot_ly(x = colnames(cm),
y = rownames(cm),
z = cm,
colors = colorRamp(div_colors),
type='heatmap',
hoverinfo='text',
text = grid_labels
) %>% layout(yaxis=list(autorange='reversed'))
My problem is that without forcing the colorRamp endpoints to c(-1,1), the white color doesn't match correlation of 0, and the dark red maps to the minimum observed, rather than -1.
As #rawr mentioned in a comment, the solution is to set zmin and zmax, as in:
plot_ly(x = colnames(cm),
y = rownames(cm),
z = cm,
zmin=-1, # <============
zmax=1, # <============
colors = colorRamp(div_colors),
type='heatmap',
hoverinfo='text',
text = grid_labels
) %>% layout(yaxis=list(autorange='reversed'))
Which produces the desired result. (The legend bar is shorter, presumably due to a change in default sizes in a newer version of plotly.)
This might sound like a strange process, but its the best I can think of to control rasterised colour gradients with respect to discrete objects (points, lines, polygons). I'm 95% there but can't quite plot correctly.
This should illustrate proof of concept:
require(raster)
r = matrix(56:255, ncol=20) # reds
b = t(matrix(56:255, ncol=10)) # blues
col = matrix(rgb(r, 0, b, max=255), ncol=20) # matrix of colour strings
ras = raster(r) # data raster object
extent(ras) = extent(1,200,1,100) # set extent for aspect
plot(ras, col = col, axes=F, asp=T) # overwrite data with custom colours
Here I want to clip a raster to a triangle and create colour gradient of pixels inside based on their distances to one of the sides. Sorry for length but its the most minimal example I can design.
require(raster); require(reshape2); require(rgeos)
# equilateral triangle
t_s = 100 # half side
t_h = floor(tan(pi*60/180) * t_s) # height
corners = cbind(c(0, -t_s, t_s, 0), c(t_h, 0, 0, t_h))
trig = SpatialPolygons(list(Polygons(list(Polygon(corners)),"triangle")))
# line to measure pixel distances to
redline = SpatialLines(list(Lines(Line(corners[1:2,]), ID='redline')))
plot(trig); plot(redline, add=T, col='red', lwd=3)
# create a blank raster and clip to triangle
r = raster(mat.or.vec(nc = t_s*2 + 1, nr = t_h))
extent(r) = extent(-t_s, t_s, 0, t_h)
r = mask(r, trig)
image(r, asp=T)
# extract cell coordinates into d.f.
cells = as.data.frame(coordinates(rasterToPoints(r, spatial=T)))
# calculate distance of each pixel to redline with apply
dist_to_line = function(xy, line){
point = readWKT(paste('POINT(', xy[1], xy[2], ')'))
gDistance(point, line) / t_h
}
cells$dists = apply(cells, 1, dist_to_line, line=redline)
cells$cols = rgb(1 - cells$dists, 0, 0)
length(unique(cells$cols)) # count unique colours
# use custom colours to colour triangle pixels
image(r, col = cells$cols, asp=T)
plot(r, col = cells$cols, asp=T)
As you can see the plotting fails to overwrite as in the first example, but the data seems fine. Trying to convert to matrix also fails:
# try convertying colours to matrix
col_ras = acast(cells, y~x, value.var='cols')
col_ras = apply(col_ras, 1, rev) # rotate acw to match r
plot(r, col = col_ras, asp=T)
Very grateful for any assistance on what's going wrong.
Edit:
To show Spacedman's plotRGB method:
b = brick(draster, 1-draster, 1-draster)
plotRGB(b, scale=1)
plot(trig, col=NA, border='white', lwd=5, add=T)
Easy way is to go from your points to a spatial pixels data frame to a raster, then do the colour mapping...
Start with:
> head(cells)
x y dists
1 0.0000000 172.5 0.0014463709
2 0.0000000 171.5 0.0043391128
3 -0.9950249 170.5 0.0022523089
4 0.0000000 170.5 0.0072318546
5 0.9950249 170.5 0.0122114004
convert:
> coordinates(cells)=~x+y
> draster = raster(as(cells,"SpatialPixelsDataFrame"))
colourise:
> cols=draster
> cols[!is.na(draster)]= rgb(1-draster[!is.na(draster)],0,0)
> plot(cols, col=cols)
I'm not sure this is the right way to do things though, you might be better off creating an RGB raster stack and using plotRGB if you want fine colour control.
I have a plot made with forestplot in the rmeta package. Notice the horizontal axis has no tick marks and labels between 0.2 and 7. How could I add tick marks without labels at 1,2,3,4,5 and 6 without labelling them? I just want the tick marks here. Here is the plot:
How do I have the ticks at 0.2,1,2,3,4,5,6 and 7, but I labelled only at c(0.2,7)? This the code:
library(rmeta)
tabletext<-rbind(c("A","3.77"),
c("B","1.33"),
c("C","1.32"),
c("D","1.12"),
c("E","1.58"),
c("F","0.9"))
m=c(3.77,1.33,1.32,1.12,1.58,0.9)
l=c(0.6144,0.644,0.6536,0.4536,1.0116,0.7236)
u=c(6.9256,2.016,1.9864,1.7864,2.1484,1.0764)
#overview datafile:
cbind(tabletext, m,l,u)
m l u
[1,] "A" "3.77" "3.77" "0.6144" "6.9256"
[2,] "B" "1.33" "1.33" "0.644" "2.016"
[3,] "C" "1.32" "1.32" "0.6536" "1.9864"
[4,] "D" "1.12" "1.12" "0.4536" "1.7864"
[5,] "E" "1.58" "1.58" "1.0116" "2.1484"
[6,] "F" "0.9" "0.9" "0.7236" "1.0764"
forestplot(tabletext,m,l,u, zero=1, xticks=c(0.2,7),col=meta.colors(box="royalblue",line="darkblue", summary="royalblue"))
I could extend the xticks=c(0.2,7) to xticks=c(0.2,1,2,3,4,5,6,7), but then all the labels at 2,3,4,5,6 would also be printed, which I dont want to.
Thanks for the suggestion. The rmeta does not have this option but I've added this to the forestplot-package (currently in the develop branch 1.2.1):
tabletext<-rbind(c("A","3.77"),
c("B","1.33"),
c("C","1.32"),
c("D","1.12"),
c("E","1.58"),
c("F","0.9"))
m=c(3.77,1.33,1.32,1.12,1.58,0.9)
l=c(0.6144,0.644,0.6536,0.4536,1.0116,0.7236)
u=c(6.9256,2.016,1.9864,1.7864,2.1484,1.0764)
#overview datafile:
xticks <- seq(from = 0.2, to = 7, by = .5)
xlabels <- rep(TRUE, length.out = length(xticks))
xlabels[xticks > 2] <- FALSE
xlabels[length(xlabels)] <- TRUE
attr(xticks, "labels") <- xlabels
forestplot(tabletext,new_page = TRUE,
m,l,u,
zero=1,
xticks=xticks,
col=fpColors(box="royalblue",line="darkblue", summary="royalblue"))
Download the develop version using devtools:
devtools::install_github("gforge/forestplot", ref="develop")