How to plot a formula with a given range? - r

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

Related

How do I add the degree symbol and letters to each value along the x- and y-axis of a graph

So I am trying to add the degree symbol and some letters to the axis values of my graph to make them look like longitude and latitudes.
My current graph:
Want to make the axis look like this graph (with e.g., 90°N etc.)
This is the code I am using to generate my current graph:
image.plot(lon_baseline_temp, lat_baseline_temp, dat_baseline_temp,
col=rev(brewer.pal(11,"RdBu")), xlab="",
ylab="",
main="Global surface temperature (Baseline)", sub="Year 1970 ~ 1999", font.sub=2,
legend.lab="K", legend.line=2.5, legend.mar=7,
xaxp=c(-180, 180, 6), yaxp=c(-90, 90, 6), las=1)
title(ylab = expression(paste("Latitude "(degree))), line = 2, cex.lab = 1)
title(xlab = expression(paste("Longitude "(degree))), line = 2.5, cex.lab = 1)
minor.tick(nx = 5, ny = 5, tick.ratio = 0.5)
map(database = 'world', add = T, lwd=1.5)
I would really appreciate any help on this soon, thank you very much!
I cant use your data but I think you just need to use a specify your labels as follows:
#some example plot
g <- ggplot() + geom_point(aes(50,50)) + ylim(0,100) + xlim(0,100) + labs(y = "Latitude",x = "Longitude")
#plot it
g
#add a new scale with specific labels
g + scale_y_continuous(breaks = c(0,25,50,75,100),
limits = c(0,100),
labels = c(expression(0~degree),
expression(25~degree),
expression(50~degree),
expression(75~degree),
expression(100~degree)
)
) +
labs(y = "Latitude",x = "Longitude")
#plot
g

contourplot color and labels options in Lattice for R

I am quite new to Lattice and I am stuck with some possibly basic coding. I am using shapefiles and geoTIFFS to produce maps of animals distribution and in particular I have:
1 x point shapefile
2 x geoTIFF
1 x polygon shapefile
I am overlapping a levelplot of one of the geoTIFF (UD generated with adehabitatHR) with a contourplot of the same geoTIFF at specific intervals (percentile values), a contourplot of the second geoTIFF (depth raster from ETOPO2) for three specific values (-200, -1000 and -2000), the point shapefile (animal locations) and the polygon shapefile (land). All works fine but I need to change the font size of contour plot labels, their length (i.e. from 0.12315 to 0.123) and positioning for all the contourplots. For the depth contourplot I would like to change the style of each line in something like "continous line", "dashed line" and "point line", and for the contourplot of the UD I would like to change the color of each line using a yellow to red palette.
As far as I understand, I should use panel functions to implement these changes (e.g. Controlling z labels in contourplot) but i am not quite sure how to do it. Part of my code to generate the "plot":
aa <-
quantile(
UD_raster,
probs = c(0.25, 0.75),
type = 8,
names = TRUE
)
my.at <- c(aa[1], aa[2])
depth<-c(-100, -200, -2000)
levelplot(
UD_raster,
xlab = "",
ylab = "",
margin = FALSE,
contour = FALSE,
col.regions = viridis(100),
main = "A",
maxpixels = 2e5
) + layer(sp.polygons(Land, fill = "grey40", col = NA)) + layer(sp.points(locations, pts = 2, col = "red")) + contourplot(
UD_raster,
at = my.at,
labels = TRUE,
margin = FALSE
) + contourplot(
ETOPO2,
at = depth,
labels = TRUE,
margin = FALSE
)
A simplified image, with no UD layer and no point shapefile can be found here and as you can see it is pretty messy. Thanks for your help.
So far for the ETOPO2 countourplot I have solved by eliminating the labels and adding the argument lty to style the line. Because I can't figure out how to use lty with different values for each single line in my contour, I have replicated the contourplot function three times on the same surface, one for each contour I am interested into (this was easy because I only need three contours).
For the position, font and font size of the labels of the remaining contourplot I have used
labels = list(cex = 0.8, "verdana"),
label.style = "flat"
To "shorten" the length of the labels I have used the function round where I specify to which decimal digit to round number.
So now my new code looks like:
aa <-
quantile(
UD_raster,
probs = c(0.25, 0.75),
type = 8,
names = TRUE
)
my.at <- c(aa[1], aa[2])
my.at <- round(my.at, 3)
levelplot(
UD_raster,
xlab = "",
ylab = "",
margin = FALSE,
contour = FALSE,
col.regions = viridis(100),
main = "A",
maxpixels = 2e5
) + layer(sp.polygons(Land, fill = "grey40", col = NA)) + layer(sp.points(positions, pts = 2, col = "red")) + contourplot(
UD_raster,
at = my.at,
labels = list(cex = 0.8, "verdana"),
label.style = "flat",
margin = FALSE
) + contourplot(
ETOPO2,
at = -200,
labels = FALSE,
margin = FALSE,
lty = 1,
pretty = TRUE
) + contourplot(
ETOPO2,
at = -1000,
labels = FALSE,
margin = FALSE,
lty = 2,
pretty = TRUE
) + contourplot(
ETOPO2,
at = -2000,
labels = FALSE,
margin = FALSE,
lty = 3,
pretty = TRUE
)
As one could expect, it takes a bit longer to produce the plot. Still no idea on how to change the colors of the UD contourplot.

Is there a way to use R to break chart axis and break linear regression line?

I'm trying to figure out how to modify a scatter-plot that contains two groups of data along a continuum separated by a large gap. The graph needs a break on the x-axis as well as on the regression line.
This R code using the ggplot2 library accurately presents the data, but is unsightly due to the vast amount of empty space on the graph. Pearson's correlation is -0.1380438.
library(ggplot2)
p <- ggplot(, aes(x = dis, y = result[, 1])) + geom_point(shape = 1) +
xlab("X-axis") +
ylab("Y-axis") + geom_smooth(color = "red", method = "lm", se = F) + theme_classic()
p + theme(plot.title = element_text(hjust = 0.5, size = 14))
This R code uses gap.plot to produce the breaks needed, but the regression line doesn't contain a break and doesn't reflect the slope properly. As you can see, the slope of the regression line isn't as sharp as the graph above and there needs to be a visible distinction in the slope of the line between those disparate groups.
library(plotrix)
gap.plot(
x = dis,
y = result[, 1],
gap = c(700, 4700),
gap.axis = "x",
xlab = "X-Axis",
ylab = "Y-Axis",
xtics = seq(0, 5575, by = 200)
)
abline(v = seq(700, 733) , col = "white")
abline(lm(result[, 1] ~ dis), col = "red", lwd = 2)
axis.break(1, 716, style = "slash")
Using MS Paint, I created an approximation of what the graph should look like. Notice the break marks on the top as well as the discontinuity between on the regression line between the two groups.
One solution is to plot the regression line in two pieces, using ablineclip to limit what's plotted each time. (Similar to #tung's suggestion, although it's clear that you want the appearance of a single graph rather than the appearance of facets.) Here's how that would work:
library(plotrix)
# Simulate some data that looks roughly like the original graph.
dis = c(rnorm(100, 300, 50), rnorm(100, 5000, 100))
result = c(rnorm(100, 0.6, 0.1), rnorm(100, 0.5, 0.1))
# Store the location of the gap so we can refer to it later.
x.axis.gap = c(700, 4700)
# gap.plot() works internally by shifting the location of the points to be
# plotted based on the gap size/location, and then adjusting the axis labels
# accordingly. We'll re-compute the second half of the regression line in the
# same way; these are the new values for the x-axis.
dis.alt = dis - x.axis.gap[1]
# Plot (same as before).
gap.plot(
x = dis,
y = result,
gap = x.axis.gap,
gap.axis = "x",
xlab = "X-Axis",
ylab = "Y-Axis",
xtics = seq(0, 5575, by = 200)
)
abline(v = seq(700, 733), col = "white")
axis.break(1, 716, style = "slash")
# Add regression line in two pieces: from 0 to the start of the gap, and from
# the end of the gap to infinity.
ablineclip(lm(result ~ dis), col = "red", lwd = 2, x2 = x.axis.gap[1])
ablineclip(lm(result ~ dis.alt), col = "red", lwd = 2, x1 = x.axis.gap[1] + 33)

R levelplot: color green-white-red (white on 0) according to one variable, but show the values of another variable

The title is pretty much self-descriptive. I want to do a heatmap-like plot with lattice, showing the data values as well, something like in here
However, in my case, I want to color the plot according to one variable (fold.change), but show the values of another variable (p.value).
It would be optimal that the color range is green-white-red, and the white is on 0 (negative fold.change values in green, and positive ones in red).
My last question would be how to change the text size of the title and axis text, remove axis title, and rotate x axis text 45 degrees; I don't find this information in the documentation. Thanks!
This is my MWE so far:
library(lattice)
library(latticeExtra)
library(RColorBrewer)
pv.df <- data.frame(compound = rep(LETTERS[1:8], each = 3),
comparison = rep(c("a/b", "b/c", "a/c"), 8),
p.value = runif(24, 0, 1),
fold.change = runif(24, -2, 6))
myPanel <- function(x, y, z, ...) {
panel.levelplot(x,y,z,...)
panel.text(x, y, round(z,1))
}
cols <- rev(colorRampPalette(brewer.pal(6, "RdYlGn"))(20))
png(filename = "test.png", height = 1000, width = 600)
print(
levelplot(fold.change ~ comparison*compound,
pv.df,
panel = myPanel,
col.regions = cols,
colorkey = list(col = cols,
at = do.breaks(range(pv.df$fold.change), 20)),
scales = list(x = list(rot = 90)),
main = "Total FAME abundance - TREATMENT",
type = "g")
)
dev.off()
Which produces this plot:
Thanks!
There are several parts to your question. Let's address them one by one:
1: Change labels. This can be done by varying the 3rd argument for panel.text():
myPanel <- function(x, y, z, ...) {
panel.levelplot(x, y, z, ...)
panel.text(x, y, round(pv.df$p.value, 2))
}
2: Change color scale with white positioned at 0. Calculate how long each segment of the color scale should be, then define each segment separately:
color.ramp.length <- 20
negative.length <- round(abs(range(pv.df$fold.change)[1]) /
diff(range(pv.df$fold.change)) *
color.ramp.length)
positive.length <- color.ramp.length - negative.length
cols <- c(colorRampPalette(c("seagreen", "white"))(negative.length),
colorRampPalette(c("white", "firebrick"))(positive.length))
(Note: you can use other color options from here. I just find the colors associated with "red" / "green" an eye sore.)
3: Modify axis titles / labels. Specify the relevant arguments in levelplot().
levelplot(fold.change ~ comparison*compound,
pv.df,
panel = myPanel,
col.regions = cols,
colorkey = list(col = cols,
at = do.breaks(range(pv.df$fold.change),
color.ramp.length)),
xlab = "", ylab = "", # remove axis titles
scales = list(x = list(rot = 45), # change rotation for x-axis text
cex = 0.8), # change font size for x- & y-axis text
main = list(label = "Total FAME abundance - TREATMENT",
cex = 1.5)) # change font size for plot title

Remove upper axis in plot glmnet

When using glmnet and making a plot of the coefficient path, I would like to remove the axis above the plot.
How do you remove this axis? I found this toy example on the web:
library(glmnet)
age <- c(4,8,7,12,6,9,10,14,7)
gender <- c(1,0,1,1,1,0,1,0,0) ; gender<-as.factor(gender)
bmi_p <- c(0.86,0.45,0.99,0.84,0.85,0.67,0.91,0.29,0.88)
m_edu <- c(0,1,1,2,2,3,2,0,1); m_edu<-as.factor(m_edu)
p_edu <- c(0,2,2,2,2,3,2,0,0); p_edu<-as.factor(p_edu)
f_color <- c("blue", "blue", "yellow", "red", "red", "yellow", "yellow", "red", "yellow")
asthma <- c(1,1,0,1,0,0,0,1,1)
f_color <- as.factor(f_color)
xfactors <- model.matrix(asthma ~ gender + m_edu + p_edu + f_color)[,-1]
x <- as.matrix(data.frame(age, bmi_p, xfactors))
glmmod<-glmnet(x,y=as.factor(asthma),alpha=1,family='binomial')
plot(glmmod,xvar="lambda", axes=FALSE)
This unwanted axis is made with axis function, I guess. We can use this function one more time to cover it. The trick is as follows:
1) Create a sequence with many points at which tick-marks are to be drawn.
2) Make them bigger (lengthen upwards)
3) Enlarge the width of the axis
4) Change the white colour and switch off labels
plot(glmmod, xvar = "lambda", axes = F, xlab = "", ylab = "")
axis(side = 3,
at = seq(par("usr")[1], par("usr")[2], len = 1000),
tck = -0.5,
lwd = 2,
col = "white",
labels = F)

Resources