Color by group and legend in plot3D - r

I'm trying to create my own 3D histogram using plot3D, so I took a look at this page as a starter before applying it on my own data. The code is clear and straightforward enough but I wonder how I can group rows of data (formatted as matrix indices in the example VADeaths data) into fewer categories (e.g., 50-54 & 55-59 --> "Fifties", 60-64 & 65-69 --> "Sixties", 70-74 --> "> 70") and assign them to different colors (e.g, "Fifties: blue", "Sixties: yellow", "> 70: white")? And, also, to have this information displayed on the legend to the right of the 3D plot?
Below is a working example listed on the reference page.
# install.packages("plot3D")
library(plot3D)
data(VADeaths)
# plotting
hist3D (x = 1:5, y = 1:4, z = VADeaths,
bty = "g", phi = 20, theta = -60,
xlab = "", ylab = "", zlab = "", main = "VADeaths",
col = "#0072B2", border = "black", shade = 0.8,
ticktype = "detailed", space = 0.15, d = 2, cex.axis = 1e-9)
# label x axis: age group (this part is to be sorted into fewer categories)
text3D(x = 1:5, y = rep(0.5, 5), z = rep(3, 5),
labels = rownames(VADeaths),
add = TRUE, adj = 0)
# label y axis: gender by urbal/rural residency
text3D(x = rep(1, 4), y = 1:4, z = rep(0, 4),
labels = colnames(VADeaths),
add = TRUE, adj = 1)
I've referenced this earlier post but can't seem to understand it.
It'll be really appreciated if someone could share some tips on this.

Related

Improving graph quality while exporting in r

I have written following code for comparing between to different variables over a period. The code works fine but only problem is when i output the file as "jpeg" the lines are not smooth and my arrow is not as smooth as i like it to be in other words the graph feels very low quality. But when i output it as "pdf" i get smooth lines and graph is of higher quality. But pdf files are high in file size and i need to insert these graphs in word file. I find it relatively easy to append jpeg into the word file. So is it possible to improve image quality while being in jpeg format. I tried using res argument in jpeg() but it doesnot output the graph as it is displayed in the rstudio.
I will appreciate the help. Thanks!
code:
library(shape)
library(Hmisc)
### samples ######
xaxs = seq(1,30,length=30)
precip = sample(200:800, 30)
ero = sample(0:10, 30, replace = T)
#########
svpth = getwd()
nm = "try.jpeg"
jpeg(paste0(svpth,"/",nm), width=950 , height =760, quality = 200, pointsize =15)
par(mar= c(5,4,2,4), oma=c(1,1,1,1))
plot(xaxs,precip, type = "p", pch=15, col="green", ylim = c(200,1000),
xlab = "Year" , ylab = "", cex.main=1.5, cex.axis=1.5, cex.lab=1.5)
lines(xaxs, precip,lty =1, col="green")
# xtick<-seq(0,30, by=1)
# axis(side = 1, at=xtick, labels = FALSE )
minor.tick(nx=5, ny=2, tick.ratio=0.5, x.args = list(), y.args = list())
mtext("Depth (mm)", side = 2, line = 2.7, cex = 1.5)
par(new=T)
plot(xaxs, (ero * 10), ylim = c(0,max(pretty(range((ero * 10))))+20), type = "p", pch=20, cex=1.5, col="red", axes = F, xlab = "", ylab = "")
lines(xaxs, (ero * 10),lty =2, col="red")
axis(side = 4, at=pretty(range((ero * 10))), cex.axis = 1.5)
# mtext("Erosion (t/ha/yr)", side = 4, line = 2.2, cex = 1.5)
mtext(expression(paste("Erosion (t ", ha^-1, yr^-1, ")")), side = 4, line = 2.7, cex = 1.5)
legend("topleft", legend = c("Precipitation","Erosion"), lty = c(1,2), pch = c(15,20), col = c("green","red"), cex = 1.6, bty = "n")
####arrow
Arrows(7, 85, 11, 90,lwd= 1.1)
Arrows(26, 85, 21, 90, lwd= 1.1)
txt = "High erosion rates in \nwheat-planting years"
xt = 16
yt = 85
text(xt, yt, labels = txt, family="serif", cex = 1.23)
sw = strwidth(txt)+1.4
sh = strheight(txt) +6
frsz = 0.38
rect(xt - sw/2 - frsz, yt - sh/2 - frsz, xt + sw/2 + frsz, yt + sh/2 + frsz-1)
# legend(15,80, legend = c("High erosion rates in \nwheat-planting years\n"),
# xjust = 0.5, yjust = 0.5)
dev.off()
It didn't use base R, but this makes an svg, which is smaller than a jpeg and will create some beautiful images. MS Word has no problems with svg, either.
The svg-- 18 kb; the jpeg-- 592 kb for the same image.
Use if it works, if not, well, perhaps someone else could use it? This won't show in the plot pane in RStudio, it will show in the viewer pane.
After the code, I have an image of saving the plot in the viewer pane in RStudio.
library(plotly)
df = data.frame("Year" = xaxs, "Depth" = precip, "Erosion" = ero *10)
p = plot_ly(df) %>%
add_trace(x = ~Year, y = ~Depth,
type = 'scatter', mode = 'lines', # to have both the points and lines use 'lines+markers'
name = "Depth",
line = list(shape = "spline", # smooth the curves in the lines (not that effective with lines+markers)
color = "green")) %>%
add_trace(x = ~Year, y = ~Erosion,
mode = 'lines',
name = "Erosion",
yaxis = "y2", # second y axis
line = list(dash = 'dash', # dash the lines
shape = "spline", # smooth the curves in the lines
color = "red")) %>% # without "lines+markers" spline will smooth out the points of the line
add_annotations(inherit = F, # add the arrows at the top of the plot
x = list(12, 18), # this is plot coordinates
y = list(800, 800),
ax = list(-60, 60), # this is pixels
ay = list(10, 10),
showarrow = T,
text = "") %>%
add_annotations(inherit = F, # add the textbox at the top of the plot
x = 15, y = 800,
ax = 0, ay = 0,
showarrow = F,
bordercolor = 'black',
text = "High erosion rates in\nwheat-planting years") %>%
layout(yaxis2 = list(overlaying = "y", side = "right", # add labels
title = paste0("Erosion (t ",
"ha<sup>-1</sup>",
"yr<sup>-1</sup>",
")")),
yaxis = list(title = "Depth (mm)"),
legend = list(x = .1, y = 1000),
margin = list(r = 80)) # right margin space for label
To save it, add the functionality. The icons at the top of the plot in the image at the end won't show until you hover over them. I think you may find that if you use this, the height/width specifications you have aren't the best fit anymore.
(p <- p %>% config( # save the plot; add a save function to the plot
toImageButtonOptions = list(
format = "svg",
filename = "try",
width = 950,
height = 760)) # end config
) # end () for print simo object assignment
The plot. The width and height in this image are 950 x 550.

R: Error in FUN(X[[i]], ...) : only defined on a data frame with all numeric variables

I am working with the R programming language. I am trying to plot some categorical and continuous data that I am working with, but I am getting an error that tells me that such plots are only possible with "only numeric variables".
library(survival)
library(ggplot2)
data(lung)
data = lung
data$sex = as.factor(data$sex)
data$status = as.factor(data$status)
data$ph.ecog = as.factor(data$ph.ecog)
str(data)
#plot
mycolours <- rainbow(length(unique(data$sex)), end = 0.6)
# png("gally.png", 500, 400, type = "cairo", pointsize = 14)
par(mar = c(4, 4, 0.5, 0.75))
plot(NULL, NULL, xlim = c(1, 5), ylim = range(data[, 1:6]) + c(-0.2, 0.2),
bty = "n", xaxt = "n", xlab = "Variable", ylab = "Standardised value")
axis(1, 1:5, labels = colnames(data)[1:6])
abline(v = 1:5, col = "#00000033", lwd = 2)
abline(h = seq(-2.5, 2.5, 0.5), col = "#00000022", lty = 2)
for (i in 1:nrow(data)) lines(as.numeric(data[i, 1:6]), col = mycolours[as.numeric(data$sex[i])])
legend("topright", c("Female", "Male"), lwd = 2, col = mycolours, bty = "n")
# dev.off()
Does anyone know if this is possible to do with both categorical and continuous data?
Thanks
Sources: R: Parallel Coordinates Plot without GGally
Yup. You just have to be careful with the values. Remember how the factors are coded internally: they are just spicy integer variables with value labels (similar to names). You can losslessly cast it to character or to numeric. For the sake of plotting, you need numbers for line coordinates, so the factor-y nature of your variables will come at the end.
Remember that the quality of your visualisation and the information content depends on the order of your variables in you data set. For factors, labels are absolutely necessary. Help the reader by doing some completely custom improvements impossible in ggplot2 in small steps!
I wrote a custom function allowing anyone to add super-legible text on top of the values that are not so obvious to interpret. Give meaningful names, choose appropriate font size, pass all those extra parameters to the custom function as an ellipsis (...)!
Here you can see that most of the dead patients are female and most of the censored ones are males. Maybe adding some points with slight jitter will give the reader idea about the distributions of these variables.
library(survival)
data(lung)
# Data preparation
lung.scaled <- apply(lung, 2, scale)
drop.column.index <- which(colnames(lung) == "sex")
lung.scaled <- lung.scaled[, -drop.column.index] # Dropping the split variable
split.var <- lung[, drop.column.index]
lung <- lung[, -drop.column.index]
mycolours <- rainbow(length(unique(split.var)), end = 0.6, v = 0.9, alpha = 0.4)
# png("gally.png", 500, 400, type = "cairo", pointsize = 14)
par(mar = c(5.5, 4, 0.5, 0.75))
plot(NULL, NULL, xlim = c(1, ncol(lung.scaled)), ylim = range(lung.scaled, na.rm = TRUE) + c(-0.2, 0.2),
bty = "n", xaxt = "n", xlab = "", ylab = "Standardised value")
axis(1, 1:ncol(lung.scaled), labels = colnames(lung), cex.axis = 0.95, las = 2)
abline(v = 1:ncol(lung), col = "#00000033", lwd = 2)
abline(h = seq(round(min(lung.scaled, na.rm = TRUE)), round(max(lung.scaled, na.rm = TRUE), 0.5)), col = "#00000022", lty = 2)
for (i in 1:nrow(lung.scaled)) lines(as.numeric(lung.scaled[i, ]), col = mycolours[as.numeric(split.var[i])])
legend("topleft", c("Female", "Male"), lwd = 3, col = mycolours, bty = "n")
# Labels for some categorical variables with a white halo for readability
labels.with.halo <- function(varname, data.scaled, labels, nhalo = 32, col.halo = "#FFFFFF44", hscale = 0.04, vscale = 0.04, ...) {
offsets <- cbind(cos(seq(0, 2*pi, length.out = nhalo + 1)) * hscale, sin(seq(0, 2*pi, length.out = nhalo + 1)) * vscale)[-(nhalo + 1), ]
ind <- which(colnames(data.scaled) == varname)
yvals <- sort(unique(data.scaled[, ind]))
for (i in 1:nhalo) text(rep(ind, length(yvals)) + offsets[i, 1], yvals + offsets[i, 2], labels = labels, col = col.halo, ...)
text(rep(ind, length(yvals)), yvals, labels = labels, ...)
}
labels.with.halo("status", lung.scaled, c("Censored", "Dead"), pos = 3)
labels.with.halo("ph.ecog", lung.scaled, c("Asymptomatic", "Symp. but ambul.", "< 50% bed", "> 50% bed"), pos = 3, cex = 0.9)
# dev.off()

How to specify breaks for y axis in R plot

I have created the following fanchart using the fanplot package. I'm trying to add axis ticks and labels to the y axis, however it's only giving me the decimals and not the full number. Looking for a solution to display the full number (e.g 4.59 and 4.61) on the y axis
I am also unsure of how to specify the breaks and number of decimal points for the labels on the y-axis using plot(). I know doing all of this in ggplot2 it would look something like this scale_y_continuous(breaks = seq(min(data.ts$Index),max(data.ts$Index),by=0.02)) . Any ideas on how to specify the breaks in the y axis as well as the number of decimal points using the base plot() feature in R?
Here is a reproductible of my dataset data.ts
structure(c(4.6049904235401, 4.60711076016453, 4.60980084146652,
4.61025389170935, 4.60544515681515, 4.60889021700954, 4.60983993107244,
4.61091608826696, 4.61138799159174, 4.61294431148318, 4.61167545843765,
4.61208284263432, 4.61421991328081, 4.61530485425155, 4.61471465043043,
4.6155992084451, 4.61195799200607, 4.61178486640435, 4.61037927954796,
4.60744590947049, 4.59979957741728, 4.59948551500254, 4.60078678080182,
4.60556092645471, 4.60934962087565, 4.60981147563749, 4.61060477704678,
4.61158365084251, 4.60963435263623, 4.61018215733317, 4.61209710959768,
4.61231368335184, 4.61071363571141, 4.61019496497916, 4.60948652606191,
4.61068813487859, 4.6084092003352, 4.60972706132393, 4.60866915174087,
4.61192565195909, 4.60878767339377, 4.61341471281265, 4.61015272152397,
4.6093479714315, 4.60750965935653, 4.60768790690338, 4.60676463096309,
4.60746490411374, 4.60885670935448, 4.60686846708382, 4.60688947889575,
4.60867708110485, 4.60448791268212, 4.60387348166032, 4.60569806689426,
4.6069320880709, 4.6087143894128, 4.61059688801283, 4.61065399116698,
4.61071421014339), .Tsp = c(2004, 2018.75, 4), class = "ts")
and here is a reproductible of the code I'm using
# # Install and Load Packages
## pacman::p_load(forecast,fanplot,tidyverse,tsbox,lubridate,readxl)
# Create an ARIMA Model using the auto.arima function
model <- auto.arima(data.ts)
# Simulate forecasts for 4 quarters (1 year) ahead
forecasts <- simulate(model, n=4)
# Create a data frame with the parameters needed for the uncertainty forecast
table <- ts_df(forecasts) %>%
rename(mode=value) %>%
mutate(time0 = rep(2019,4)) %>%
mutate(uncertainty = sd(mode)) %>%
mutate(skew = rep(0,4))
y0 <- 2019
k <- nrow(table)
# Set Percentiles
p <- seq(0.05, 0.95, 0.05)
p <- c(0.01, p, 0.99)
# Simulate a qsplitnorm distribution
fsval <- matrix(NA, nrow = length(p), ncol = k)
for (i in 1:k)
fsval[, i] <- qsplitnorm(p, mode = table$mode[i],
sd = table$uncertainty[i],
skew = table$skew[i])
# Create Plot
plot(data.ts, type = "l", col = "#75002B", lwd = 4,
xlim = c(y0 - 2,y0 + 0.75), ylim = range(fsval, data.ts),
xaxt = "n", yaxt = "n", ylab = "",xlab='',
main = '')
title(ylab = 'Log AFSI',main = 'Four-Quarter Ahead Forecast Fan - AFSI',
xlab = 'Date')
rect(y0 - 0.25, par("usr")[3] - 1, y0 + 2, par("usr")[4] + 1,
border = "gray90", col = "gray90")
fan(data = fsval, data.type = "values", probs = p,
start = y0, frequency = 4,
anchor = data.ts[time(data.ts) == y0 - .25],
fan.col = colorRampPalette(c("#75002B", "pink")),
ln = NULL, rlab = NULL)
# Add axis labels and ticks
axis(1, at = y0-2:y0 + 2, tcl = 0.5)
axis(1, at = seq(y0-2, y0 + 2, 0.25), labels = FALSE, tcl = 0.25)
abline(v = y0 - 0.25, lty = 1)
abline(v = y0 + 0.75, lty = 2)
axis(2, at = range(fsval, data.ts), las = 2, tcl = 0.5)
range(blah) will only return two values (the minimum and maximum). The at parameter of axis() requires a sequence of points at which you require axis labels. Hence, these are the only two y values you have on your plot. Take a look at using pretty(blah) or seq(min(blah), max(blah), length.out = 10).
The suggestions of #Feakster are worth looking at, but the problem here is that the y-axis margin isn't wide enough. You could do either of two things. You could round the labels so they fit within the margins, for example you could replace this
axis(2, at = range(fsval, data.ts), las = 2, tcl = 0.5)
with this
axis(2, at = range(fsval, data.ts),
labels = sprintf("%.3f", range(fsval, data.ts)), las = 2, tcl = 0.5)
Or, alternatively you could increase the y-axis margin before you make the plot by specifying:
par(mar=c(5,5,4,2)+.1)
plot(data.ts, type = "l", col = "#75002B", lwd = 4,
xlim = c(y0 - 2,y0 + 0.75), ylim = range(fsval, data.ts),
xaxt = "n", yaxt = "n", ylab = "",xlab='',
main = '')
Then everything below that should work. The mar element of par sets the number of lines printed in the margin of each axis. The default is c(5,4,4,2).

How to plot a formula with a given range?

I am looking to plot the following:
L<-((2*pi*h*c^2)/l^5)*((1/(exp((h*c)/(l*k*T)-1))))
all variables except l are constant:
T<-6000
h<-6.626070040*10^-34
c<-2.99792458*10^8
k<-1.38064852*10^-23
l has a range of 20*10^-9 to 2000*10^-9.
I have tried l<-seq(20*10^-9,2000*10^-9,by=1*10^-9), however this does not give me the results I expect.
Is there a simple solution for this in R, or do I have to try in another language?
Thank you.
Looking at the spectral radiance equation wikipedia page, it seems that your formula is a bit off. Your formula multiplies an additional pi (not sure if intended) and the -1 is inside the exp instead of outside:
L <- ((2*pi*h*c^2)/l^5)*((1/(exp((h*c)/(l*k*T)-1))))
Below is the corrected formula. Also notice I have converted it into a function with parameter l since this is a variable:
T <- 6000 # Absolute temperature
h <- 6.626070040*10^-34 # Plank's constant
c <- 2.99792458*10^8 # Speed of light in the medium
k <- 1.38064852*10^-23 # Boltzmann constant
L <- function(l){((2*h*c^2)/l^5)*((1/(exp((h*c)/(l*k*T))-1)))}
# Plotting
plot(L, xlim = c(20*10^-9,2000*10^-9),
xlab = "Wavelength (nm)",
ylab = bquote("Spectral Radiance" ~(KW*sr^-1*m^-2*nm^-1)),
main = "Plank's Law",
xaxt = "n", yaxt = "n")
xtick <- seq(20*10^-9, 2000*10^-9,by=220*10^-9)
ytick <- seq(0, 4*10^13,by=5*10^12)
axis(side=1, at=xtick, labels = (1*10^9)*seq(20*10^-9,2000*10^-9,by=220*10^-9))
axis(side=2, at=ytick, labels = (1*10^-12)*seq(0, 4*10^13,by=5*10^12))
The plot above is not bad, but I think we can do better with ggplot2:
h <- 6.626070040*10^-34 # Plank's constant
c <- 2.99792458*10^8 # Speed of light in the medium
k <- 1.38064852*10^-23 # Boltzmann constant
L2 <- function(l, T){((2*h*c^2)/l^5)*((1/(exp((h*c)/(l*k*T))-1)))} # Plank's Law
classical_L <- function(l, T){(2*c*k*T)/l^4} # Rayleigh-Jeans Law
library(ggplot2)
ggplot(data.frame(l = c(20*10^-9,2000*10^-9)), aes(l)) +
geom_rect(aes(xmin=390*10^-9, xmax=700*10^-9, ymin=0, ymax=Inf),
alpha = 0.3, fill = "lightblue") +
stat_function(fun=L2, color = "red", size = 1, args = list(T = 3000)) +
stat_function(fun=L2, color = "green", size = 1, args = list(T = 4000)) +
stat_function(fun=L2, color = "blue", size = 1, args = list(T = 5000)) +
stat_function(fun=L2, color = "purple", size = 1, args = list(T = 6000)) +
stat_function(fun=classical_L, color = "black", size = 1, args = list(T = 5000)) +
theme_bw() +
scale_x_continuous(breaks = seq(20*10^-9, 2000*10^-9,by=220*10^-9),
labels = (1*10^9)*seq(20*10^-9,2000*10^-9,by=220*10^-9),
sec.axis = dup_axis(labels = (1*10^6)*seq(20*10^-9,2000*10^-9,by=220*10^-9),
name = "Wavelength (\U003BCm)")) +
scale_y_continuous(breaks = seq(0, 4*10^13,by=5*10^12),
labels = (1*10^-12)*seq(0, 4*10^13,by=5*10^12),
limits = c(0, 3.5*10^13)) +
labs(title = "Black Body Radiation described by Plank's Law",
x = "Wavelength (nm)",
y = expression("Spectral Radiance" ~(kWsr^-1*m^-2*nm^-1)),
caption = expression(''^'\U02020' ~'Spectral Radiance described by Rayleigh-Jeans Law, which demonstrates the ultraviolet catastrophe.')) +
annotate("text",
x = c(640*10^-9, 640*10^-9, 640*10^-9, 640*10^-9,
150*10^-9, (((700-390)/2)+390)*10^-9, 1340*10^-9),
y = c(2*10^12, 5*10^12, 14*10^12, 31*10^12,
35*10^12, 35*10^12, 35*10^12),
label = c("3000 K", "4000 K", "5000 K", "6000 K",
"UV", "VISIBLE", "INFRARED"),
color = c(rep("black", 4), "purple", "blue", "red"),
alpha = c(rep(1, 4), rep(0.6, 3)),
size = 4.5) +
annotate("text", x = 1350*10^-9, y = 23*10^12,
label = deparse(bquote("Classical theory (5000 K)"^"\U02020")),
color = "black", parse = TRUE)
Notes:
I created L2 by also making absolute temperature T a variable
For each T, I plot the function L2 using different colors for representation. I've also added a classical_L function to demonstrate classical theory of spectral radiance
geom_rect creates the light blue shaded area for "VISIBLE" light wavelength range
scale_x_continuous sets the breaks of the x axis, while labels sets the axis tick labels. Notice I have multiplied the seq by (1*10^9) to convert the units to nanometer (nm). A second x-axis is added to display the micrometer scale
Analogously, scale_y_continuous sets the breaks and tick labels for y axis. Here I multiplied by (1*10^-12) or (1*10^(-3-9)) to convert from watts (W) to kilowatts (kW), and from inverse meter (m^-1) to inverse nanometer (nm^-1)
bquote displays superscripts correctly in the y axis label
annotate sets the coordinates and text for curve labels. I've also added the labels for "UV", "VISIBLE" and "INFRARED" light wavelengths
ggplot2
Plot from wikipedia:
Image source: https://upload.wikimedia.org/wikipedia/commons/thumb/1/19/Black_body.svg/600px-Black_body.svg.png

Randomly generate 3 distinct colors

I've looked at this one but does not help with the random part. Is there a better way to randomly generate 3 different colors so that the square, the circle, and the text stand out visually from one another in the code below. The colors have to be randomly generated and also distinct enough from one another. The current code works maybe only half the time
plot(0, type = "n", xlim = c(0,10), ylim = c(0,10),
ann = FALSE, axes = FALSE, asp = 1)
cols = colorRampPalette(sample(2:9,2), alpha = TRUE)(8)
polygon(x = c(1,9,9,1), y = c(1,1,9,9), border = NA, col = cols[1])
symbols(x = 5, y = 5, circles = 4, inches = FALSE,
add = TRUE, bg = cols[4], fg = NA)
text(x = 5, y = 5, labels = "Hi", col = cols[7], font = 2, cex = 3)
EXAMPLES
GOOD
POLYGON: "#FF00FFFF", CIRCLE: "#916DFFFF", TEXT: "#24DAFFFF"
BAD
POLYGON: "#00FFFFFF", CIRCLE: "#51E3E3FF", TEXT: "#A2C7C7FF"
My original answer, which uses the hcl color space, often generated color combinations that were hard to distinguish. This updated answer uses the Lab color space, which is scaled based on the perceptual distance between colors, so similar distances in Lab space should correspond to similar perceptual color differences. In Lab, L is luminance or brightness on a scale of 0 to 100. a represents green to red, and b represents blue to yellow, with both on a scale of -100 to 100.
The code below generates two random values for a and b. If we think of these two values as representing a point in the ab plane, we generate two more colors with maximum perceptual distance from each other by rotating this point first by 120 degrees and then by 240 degrees. We then choose a single L value to give us three equally spaced colors.
Below I've packaged this in a function to make it easy to generate several plots with random colors. I've also set a minimum absolute value for a and b so that we don't get colors that are too similar, and included an Lval argument for choosing the L value of the Lab colors.
Based on a several runs, it looks like this approach performs much better than my original hcl version (although this may be due not only to the use of Lab space instead of hcl space, but also because I used only one dimension of hcl space but two dimensions of Lab space).
library(colorspace)
random.colors = function(Lval=80, ABmin=50) {
# 120 deg rotation matrix
aa = 2*pi/3
rot = matrix(c(cos(aa), -sin(aa), sin(aa), cos(aa)), nrow=2, byrow=TRUE)
# Generate random A and B points in LAB space
x = runif(2, ABmin, 100) * sample(c(-1,1), 2,replace=TRUE)
# Create three equally spaced colors in Lab space and convert to RGB
cols = LAB(cbind(rep(Lval,3), rbind(x, x %*% rot, x %*% rot %*% rot)))
cols = rgb(convertColor(cols#coords, from="Lab", to="sRGB"))
plot(0, type = "n", xlim = c(0,10), ylim = c(0,10),
ann = FALSE, axes = FALSE, asp = 1)
polygon(x = c(1,9,9,1), y = c(1,1,9,9), border = NA, col = cols[1])
symbols(x = 5, y = 5, circles = 4, inches = FALSE,
add = TRUE, bg = cols[2], fg = NA)
text(x = 5, y = 5, labels = "Hi", col = cols[3], font = 2, cex = 3)
}
par(mfrow=c(3,3), mar=rep(0,4))
replicate(9,random.colors())
For simplicity, the example above constrains the a and b values to be a constant distance from the origin (in ab-space) and uses the same L value for all three colors. You could instead extend this method to use all three dimensions of the Lab space. In addition, instead of requiring a constant distance from the origin, you could pick the first color at random and then require that the next two colors be picked such that all three colors are maximally separated from each other in Lab space.
Original Answer
You could generate colors that are equally spaced in the hue dimension (that is, have the maximum possible hue separation from each other). For example:
set.seed(60)
cols = hcl(runif(1,0,359.99) + c(0,120,240), 100, 65)
plot(0, type = "n", xlim = c(0,10), ylim = c(0,10),
ann = FALSE, axes = FALSE, asp = 1)
polygon(x = c(1,9,9,1), y = c(1,1,9,9), border = NA, col = cols[1])
symbols(x = 5, y = 5, circles = 4, inches = FALSE,
add = TRUE, bg = cols[2], fg = NA)
text(x = 5, y = 5, labels = "Hi", col = cols[3], font = 2, cex = 3)
Here are nine more random draws. As you can see, there are some combinations that don't work too well. But perhaps you can play around with different ways of slicing up the color space to see if you can get something better.
One super simple way would be to sample among the eight "standard" colours.
par(mar=c(0, 0, 0, 0))
set.seed(1)
plot(0, type = "n", xlim = c(0,10), ylim = c(0,10),
ann = FALSE, axes = FALSE, asp = 1)
cols <- sample(2:8, 3)
polygon(x = c(1,9,9,1), y = c(1,1,9,9), border = NA, col = cols[1])
symbols(x = 5, y = 5, circles = 4, inches = FALSE,
add = TRUE, bg = cols[2], fg = NA)
text(x = 5, y = 5, labels = "Hi", col = cols[3], font = 2, cex = 3)

Resources