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.)
Related
I'm working on a one species, two resources phytoplankton competition model based on Tilman's work in the 70s and 80s. I have a dataframe set up for the analytical solution but am really struggling with the syntax to plot the graphs I need. Here is my code so far:
library(dplyr)
r <- 0.1
g1 <- 0.001
g2 <- 0.01
v1 <- 0.1
v2 <- 1
k1 <- 0.01
k2 <- 0.1
d <- 0.15
s1_star = (r*g1*k1*d)-((v1*(r-d))-r*g1*d)
s2_star = (r*g2*k2*d)-((v2*(r-d))-r*g2*d)
s01 = s1_star+((s02-s2_star)*(g1/g2))
params <- list(r = 0.1,
g1 = 0.001,
g2 = 0.01,
d = 0.5,
v1 = 0.1,
v2 = 1,
k1 = 0.01,
k2 = 0.1)
df <- data.frame(s02 = seq(10, 1, -1)) |>
mutate(
s1_star = (r*g1*k1*d)-((v1*(r-d))-r*g1*d),
s2_star = (r*g2*k2*d)-((v2*(r-d))-r*g2*d),
s01 = s1_star+((s02-s2_star)*(g1/g2)), ## Tilman eq 17, supply concentration of resource 1
## in the reservoir that would result in co-limitation given some concentration of
## resource 2 (s20) in the reservoir
s1_limiting_ratio = s02/s01 ## ratio of supply points that result in co-limitation
)
cbind(params, df) |> as.data.frame() -> limiting_ratio
library(ggplot2)
limiting_ratio |> ggplot(aes(x = s1_star, y = s2_star)) + geom_line()
I want to plot s1_star and s2_star as the axes (which I did), but I'm trying to add the s1_limiting_ratio as a line on the graph (it's a ratio of s02/s01, which represents when resource 1 (S1) and resource 2 (S2) are co-limited. Then, I want to plot various values of s01 and s02 on the graph to see where they fall (to determine which resource is limiting to know which resource equation to use, either S1 or S2, in the analytical solution.
I've tried googling ggplot help, and struggling to apply it to the graph I need. I'm still fairly new to R and definitely pretty new to ggplot, so I really appreciate any help and advice!
I am trying to plot a boxplot in R, where the input file has multiple columns and each column has different number of rows. With the help given on help on the following link:
boxplot of vectors with different length
I am trying:
x <- read.csv( 'filename.csv', header = T )
plot(
1, 1,
xlim=c(1,ncol(x)), ylim=range(x[-1,], na.rm=TRUE),
xaxt='n', xlab='', ylab=''
)
axis(1, labels=colnames(x), at=1:ncol(x))
for(i in 1:ncol(x)) {
p <- x[,i]
boxplot(p, add=T, at=i)
}
I am trying to plot the values in log scale. But defining log ="y", I am getting the following error:
Error in xypolygon(xx, yy, lty = "blank", col = boxfill[i]) :
plot.new has not been called yet
Following is the sample of my input csv data:
A B C D
2345.42 932.19 40.8 26.19
138.48 1074.1 4405.62 4077.16
849.35 0.0 1451.66 1637.39
451.38 146.22 4579.6 5133.14
5749.01 7250.08 12.23 0.09
4125.48 129.46 49.51
440.38 6405.02
Your data as a reproducible example
Note I had to remove an extra element
library(data.table)
df <- fread("A,B,C,D
2345.42,932.19,40.8,26.19
138.48,1074.1,4405.62,4077.16
849.35,0.0,1451.66,1637.39
451.38,146.22,4579.6,5133.14
5749.01,7250.08,12.23,0.09
4125.48,129.46,49.51,440.38", sep=",", header=T)
dplyr and tidyr solution
library(dplyr)
library(tidyr)
df1 <- df %>%
replace(.==0,NA) %>% # make 0 into NA
gather(var,values,A:D) %>% # convert from wide (4-col) to long (2-col) format
mutate(values = log10(values)) # log10 transform
If you want log2, simply replace log10 with log2
Output
boxplot(values ~ var, df1)
A little extra
For log10 scale, I like to add 1 to my values to eliminate negative values since log10(0 < x < 1) = -value. This sets the minimum value on your plot as 0 since 0 + 1 = 1 and log10(1) = 0
I'm working on trying to represent an office building in R. Later, I'll need to represent multiple floors, but for now I need to start with one floor. There are clusters of cubes all in a regular structure. There are four small cubes for junior staff (4x4), and two larger cubes for a senior engineer and a manager (4x6). Once these are mapped out, I need to be able to show if they are occupied or free for new hires -- by color (like red for occupied, green for available). These are all laid out the same way, with the big ones on one end. For example,
+----+--+--+
| S |J1|J2|
+----+--+--+
<-hallway-->
+----+--+--+
| M |J3|J4|
+----+--+--+
I first thought I could use ggplot and just scatter plot everybody out, but I can't figure out how to capture the different size cubes with geom_point. I spent some time looking at maps, but it seems like I can't really take advantage of the regular structure of my floorplan -- maybe that really is the way to go and I take advantage of my regular structure in building out a map? Does R have a concept I should Google for this kind of structure?
In the end, I'll get a long data file, with the type of cubicle, the x and y coordinates of the cluster, and a "R" or "G" (4 columns).
You could also write a low-level graphic function; it's sometimes easier to tune than removing more and more components from a complex plot,
library(grid)
library(gridExtra)
floorGrob <- function(S = c(TRUE, FALSE), J = c(TRUE, FALSE, TRUE, TRUE),
draw=TRUE, newpage=is.null(vp), vp=NULL){
m <- rbind(c(1,3,4), # S1 J1 J2
c(7,7,7), # hall
c(2,5,6)) # S2 J3 J4
fills <- c(c("#FBB4AE","#CCEBC5")[c(S, J)+1], "grey90")
cellGrob <- function(f) rectGrob(gp=gpar(fill=f, col="white", lwd=2))
grobs <- mapply(cellGrob, f=fills, SIMPLIFY = FALSE)
g <- arrangeGrob(grobs = grobs, layout_matrix = m, vp = vp, as.table = FALSE,
heights = unit(c(4/14, 1/14, 4/14), "null"),
widths = unit(c(6/14, 4/14, 4/14), "null"), respect=TRUE)
if(draw) {
if(newpage) grid.newpage()
grid.draw(g)
}
invisible(g)
}
floorGrob()
How about?
df <- expand.grid(x = 0:5, y = 0:5)
df$color <- factor(sample(c("green", "red"), 36, replace = T))
head(df)
# x y color
# 1 0 0 green
# 2 1 0 green
# 3 2 0 green
# 4 3 0 red
# 5 4 0 green
# 6 5 0 red
library(ggplot2)
ggplot(df, aes(x, y, fill = color)) +
geom_tile() +
scale_fill_manual(name = "Is it open?",
values = c("lightgreen", "#FF3333"),
labels = c("open", "not open"))
I found coplot {graphics} very useful for my plots. However, I would like to include there not only one line, but add there one another. For basic graphic I just need to add = TRUE to add another line, or tu use plot(..) and lines(..). For {lattice} I can save my plots as objects
a<-xyplot(..)
b<-xyplot(..)
and display it simply by a + as.layer(b). No one of these approaches works for coplot(), apparently because creating objects as a<-coplot() doesn't produce trellis graphic but NULL object.
Please, any help how to add data line in coplot()? I really like its graphic so I wish to keep it. Thank you !!
my exemle data are here: http://ulozto.cz/xPfS1uRH/repr-exemple-csv
My code:
sub.tab<-read.csv("repr_exemple.csv", , header = T, sep = "")
attach(sub.tab)
cells.f<-factor(cells, levels=c(2, 25, 100, 250, 500), # unique(cells.in.cluster)???
labels=c("size2", "size25", "size100", "size250", "size500"))
perc.f<-factor(perc, levels=c(5, 10), # unique(cells.in.cluster)???
labels=c("perc5", "perc10"))
# how to put these plots together?
a<- coplot(max_dist ~ time |cells.f + perc.f, data = sub.tab,
xlab = "ticks", type = "l", col = "black", lwd = 1)
b<- coplot(mean_dist ~ time |cells.f * perc.f, data = sub.tab,
xlab = "ticks", type = "l", col = "grey", lwd = 1)
a + as.layer(b) # this doesn't work
Please, how to merge these two plots (grey and black lines)? I couldn't figure it out... Thank you !
Linking to sample data isn't really as helpful. Here's a randomly created sample data set
set.seed(15)
dd <- do.call("rbind",
do.call("Map", c(list(function(a,b) {
cbind.data.frame(a,b, x=1:5,
y1=cumsum(rpois(5,7)),
y2=cumsum(rpois(5,9)))
}),
expand.grid(a=letters[1:5], b=letters[20:22])))
)
head(dd)
# a b x y1 y2
# 1 a t 1 8 16
# 2 a t 2 13 28
# 3 a t 3 25 35
# 4 a t 4 33 45
# 5 a t 5 39 57
# 6 b t 1 4 12
I will note the coplot is a base graphics function, not Lattice. But it does have a panel= parameter. And you can have the coplot() take care of subsetting your data for you (well, calculating the indexes at least). But, like other base graphics functions, plotting different groups isn't exactly trivial. You can do it in this case with
coplot(y~x|a+b,
# make a fake y col to cover range of all y1 and y2 values
cbind(dd, y=seq(min(dd$y1, dd$y2), max(dd$y1, dd$y2), length.out=nrow(dd))),
#request subscripts to be sent to panel function
subscripts=TRUE,
panel=function(x,y,subscripts, ...) {
# draw group 1
lines(x, dd$y1[subscripts])
# draw group 2
lines(x, dd$y2[subscripts], col="red")
})
This gives
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.