Plot confidence region shading with graded alpha (transparency) level - r

I would like to plot shaded confidence regions for various lines, but would like the alpha level in these regions to vary gradually from b to c, where b is the alpha at the median, and c is the alpha at whatever outer quantile I am using. The following code generates a line and confidence region plot as I would like, but without the variable transparency.
x= 1:10+rnorm(10)
xhigh=x+rnorm(10)^2
xlow=x-rnorm(10)^2
plot(x,type='l')
polygon(x=c(1:length(xlow),length(xlow):1), y=c(xhigh,xlow[length(xlow):1]),col = rgb(1,0,0,.1),border=NA)

You can overplot many polygons:
plot(x,type='l')
for (i in seq(0, 1, 0.01)) {
polygon(x = c(x + i * (xhigh - x), x - i * (xlow - x)),
col = rgb(1, 0, 0, .005), border = NA)
}
Altough, I think your example is actually wrong, and probably want something like:
plot(x,type='l')
for (i in seq(0, 1, 0.01)) {
polygon(x = c(1:10, 10:1),
y = c(x + i * (xhigh - x), rev(x - i * abs(x - xlow))),
col = rgb(1, 0, 0, .005), border = NA)
}

Related

Density plot of the F-distribution (df1=1). Theoretical or simulated?

I am plotting the density of F(1,49) in R. It seems that the simulated plot does not match the theoretical plot when values approach the zero.
set.seed(123)
val <- rf(1000, df1=1, df2=49)
plot(density(val), yaxt="n",ylab="",xlab="Observation",
main=expression(paste("Density plot (",italic(n),"=1000, ",italic(df)[1],"=1, ",italic(df)[2],"=49)")),
lwd=2)
curve(df(x, df1=1, df2=49), from=0, to=10, add=T, col="red",lwd=2,lty=2)
legend("topright",c("Theoretical","Simulated"),
col=c("red","black"),lty=c(2,1),bty="n")
Using density(val, from = 0) gets you much closer, although still not perfect. Densities near boundaries are notoriously difficult to calculate in a satisfactory way.
By default, density uses a Gaussian kernel to estimate the probability density at a given point. Effectively, this means that at each point an observation was found, a normal density curve is placed there with its center at the observation. All these normal densities are added up, then the result is normalized so that the area under the curve is 1.
This works well if observations have a central tendency, but gives unrealistic results when there are sharp boundaries (Try plot(density(runif(1000))) for a prime example).
When you have a very high density of points close to zero, but none below zero, the left tail of all the normal kernels will "spill over" into the negative values, giving a Gaussian-type which doesn't match the theoretical density.
This means that if you have a sharp boundary at 0, you should remove values of your simulated density that are between zero and about two standard deviations of your smoothing kernel - anything below this will be misleading.
Since we can control the standard deviation of our smoothing kernel with the bw parameter of density, and easily control which x values are plotted using ggplot, we will get a more sensible result by doing something like this:
library(ggplot2)
ggplot(as.data.frame(density(val), bw = 0.1), aes(x, y)) +
geom_line(aes(col = "Simulated"), na.rm = TRUE) +
geom_function(fun = ~ df(.x, df1 = 1, df2 = 49),
aes(col = "Theoretical"), lty = 2) +
lims(x = c(0.2, 12)) +
theme_classic(base_size = 16) +
labs(title = expression(paste("Density plot (",italic(n),"=1000, ",
italic(df)[1],"=1, ",italic(df)[2],"=49)")),
x = "Observation", y = "") +
scale_color_manual(values = c("black", "red"), name = "")
The kde1d and logspline packages are not bad for such densities.
sims <- rf(1500, 1, 49)
library(kde1d)
kd <- kde1d(sims, bw = 1, xmin = 0)
plot(kd, col = "red", xlim = c(0, 2), ylim = c(0, 2))
curve(df(x, 1, 49), add = TRUE)
library(logspline)
fit <- logspline(sims, lbound = 0, knots = c(0, 0.5, 1, 1.5, 2))
plot(fit, col = "red", xlim = c(0, 2), ylim = c(0, 2))
curve(df(x, 1, 49), add = TRUE)

How to draw a half circle on a plot?

I am trying to draw some half circles on a plot, using the trigonometric functions in R.
So here is what I have :
matPoints <<- as.data.frame(cbind(X=c(-1, -(sqrt(3)/2), -(sqrt(2)/2), -0.5, 0, 0.5, sqrt(2)/2, sqrt(3)/2, 1), Y=c(0, 0.5, sqrt(2)/2, sqrt(3)/2, 1, sqrt(3)/2, sqrt(2)/2, 0.5, 0)))
plot(x = matPoints$X*W, y = matPoints$Y*W)
For the moment, it prints each point on the plot. What I want to do here is to trace a smooth line between points so it gives me a beautiful half circle of center (0, 0) and of scale W.
Any solution?
Do you mean this?
x <- seq(0, pi, length.out = 500)
W <- 3
plot(cos(x) * W, sin(x) * W, type = "l")
Since the general equation of a circle is x^2 + y^2 = r^2, you can mimic it like below as well,
r=3 # radius
x <- seq(-r,r,0.01)
y <- sqrt(r^2 - x^2)
plot(x,y,type="l")
# plot(c(x,x),c(y,-y),type="l") for a full circle.
gives,
Here's another possibility using complex numbers, and polygon to draw a closed shape.
plot(NA, xlim=c(-2,2), ylim=c(-2,2))
polygon(1i^(seq(0,2,l=100)))
Using this method you can easily change the centre, scale, rotation, fill colour etc:
plot(NA, xlim=c(-2,2), ylim=c(-2,2))
polygon(2*(1i^(seq(0,2,l=100)))*1i^.5 + .1-.3i, col="red")
polygon(1i^(seq(0,2,l=100)), col="blue")

Plotting log normal density in R has wrong height

I have a log-normal density with a mean of -0.4 and standard deviation of 2.5.
At x = 0.001 the height is over 5 (I double checked this value with the formula for the log-normal PDF):
dlnorm(0.001, -0.4, 2.5)
5.389517
When I plot it using the curve function over the input range 0-6 it looks like with a height just over 1.5:
curve(dlnorm(x, -.4, 2.5), xlim = c(0, 6), ylim = c(0, 6))
When I adjust the input range to 0-1 the height is nearly 4:
curve(dlnorm(x, -.4, 2.5), xlim = c(0, 1), ylim = c(0, 6))
Similarly with ggplot2 (output not shown, but looks like the curve plots above):
library(ggplot2)
ggplot(data = data.frame(x = 0), mapping = aes(x = x)) +
stat_function(fun = function(x) dlnorm(x, -0.4, 2.5)) +
xlim(0, 6) +
ylim(0, 6)
ggplot(data = data.frame(x = 0), mapping = aes(x = x)) +
stat_function(fun = function(x) dlnorm(x, -0.4, 2.5)) +
xlim(0, 1) +
ylim(0, 6)
Does someone know why the density height is changing when the x-axis scale is adjusted? And why neither attempt above seems to reach the correct height? I tried this with just the normal density and this doesn't happen.
curves generates a set of discrete points in the range you give it. By default it generates n = 101 points, so there is a step problem. If you increase the number of points you will have almost the correct value:
curve(dlnorm(x, -.4, 2.5), xlim = c(0, 1), ylim = c(0, 6), n = 1000)
In the first case you propose curve generates 101 points in the interval x <- c(0,6), while in the second case generates 101 points in the interval x <- c(0,1), so the step is more dense

How to plot several lines plots inside each tile of a SOM?

I'm currently working on SOM vizualisations.
This is a SOM map with codes plots generated by using kohonen package
Shortly, each circle is a neuron and inside each neuron we plot all the variable in a spectra shape.
This plot is obtain by som_obj$codes[nameoftheneuron] (som_obj is the return value of som() function)
here i have written basic function derived from https://github.com/geoss/som_visualization_r
plotCluster <- function(som_obj, cutree.obj , col_palette){
if (som_obj$grid$topo != "hexagonal"){
stop("function assumes hexgonal SOM")
}
Hexagon <- function (x, y, unitcell = 1, col = "grey", border=NA) {
polygon(c(x, x, x + unitcell/2, x + unitcell, x + unitcell,
x + unitcell/2), c(y + unitcell * 0.125, y + unitcell *
0.875, y + unitcell * 1.125, y + unitcell * 0.875,
y + unitcell * 0.125, y - unitcell * 0.125),
col = col, border=border)
}
plot(0, 0, type = "n", axes = FALSE, xlim=c(0, som_obj$grid$xdim),
ylim=c(0, som_obj$grid$ydim), xlab="", ylab= "", asp=1, main= "Clusters")
if(!is.null(col_palette)){
ColorCode = col_palette[cutree.obj]
}
else{
ColorCode <- as.factor(cutree.obj)
}
offset <- 0.5 #offset for the hexagons when moving up a row
ind <- 1
for (row in 1:som_obj$grid$ydim) {
for (column in 0:(som_obj$grid$xdim - 1)) {
Hexagon(column + offset, row - 1, col = ColorCode[ind])
ind <- ind +1}
offset <- ifelse(offset, 0, 0.5)
}
}
I only want to know how to add each plot in the tiles on my own plot.
I have 0 idea how to perform that. I have literally no clue for doing that.
I tried to get the code of the plot function from plot.kohonen but I get the truncated code only from getAnywhere(plot.kohonen)
This problem seems to be complex but I just need hints with the following question:
1 - In the plot systems imagined in the code below, how to plot something (plot or text) in each tiles?

How to draw rotated axes in R?

I want to plot the results from a six factor personality test as a circumplex.
The test in question is the Allgemeiner Interessen-Struktur-Test (AIST-R; Bergmann & Eder, 2005) [General Interest Structure Test], which measures vocational choice based on the theory of J. L. Holland (Holland codes, RIASEC). You can use the answers below to plot the "Felddarstellung" [field representation] recommended in the manual in stead of the interest profile to better visualize the vector of differentiation.
The resulting graphic should look similar to this:
The test results are given as angles and lengths.
How can I draw an axis or geometric vector in R from a starting point with a specific length, without defining the end coordinates (as required by arrows)?
How can I add tickmarks to such a vector?
How can I define the points of a polygon (here in grey) in a similar manner, i.e. by providing an angle and a distance from the origin, instead of coordinates)?
I can of course calculate the endpoints, but I would like to avoid this. Also, I wouldn't know how to add tick marks to an arrow.
My attempts that did not work:
par(pin = c(4, 4))
plot(0, 0, type = "n", xlim = c(-60, 60), ylim = c(-60, 60))
symbols(c(0, 0, 0), c(0, 0, 0), circles = c(60, 1.5, 1.5), inches = FALSE, add = TRUE, fg = c("black", "black", "white"), bg = c("transparent", "#000000", "transparent"))
arrows(0, 0, length = c(60, 60, 60, 60, 60, 60), angle = c(0, 60, 120, 180, 240, 300))
The following uses base functions and a couple of functions that we define ourselves.
While you requested a method that doesn't require calculating coordinates of segments' end points, I think this is impossible. However, we can define a simple helper function that uses some basic trigonometry to calculate the coordinates given the angle (clockwise from the positive y-axis) and the segment length. We do this below, as well as defining a function that plots a rotated axis.
get.coords <- function(a, d, x0, y0) {
a <- ifelse(a <= 90, 90 - a, 450 - a)
data.frame(x = x0 + d * cos(a / 180 * pi),
y = y0+ d * sin(a / 180 * pi))
}
rotatedAxis <- function(x0, y0, a, d, symmetrical=FALSE, tickdist, ticklen, ...) {
if(isTRUE(symmetrical)) {
axends <- get.coords(c(a, a + 180), d, x0, y0)
tick.d <- c(seq(0, d, tickdist), seq(-tickdist, -d, -tickdist))
} else {
axends <- rbind(get.coords(a, d, x0, y0), c(x0, y0))
tick.d <- seq(0, d, tickdist)
}
invisible(lapply(apply(get.coords(a, d=tick.d, x0, y0), 1, function(x) {
get.coords(a + 90, c(-ticklen, ticklen), x[1], x[2])
}), function(x) lines(x$x, x$y, ...)))
lines(axends$x, axends$y, ...)
}
get.coords takes arguments a (a vector of angles), d (a vector of segment lengths), and x0 and y0, the coordinates of the known point. Vectors a and d are recycled as necessary. The function returns a data.frame with elements x and y giving the coordinates corresponding to each angle/length pair.
rotatedAxis plots an axis between x0, y0 and the point d units away along the line at angle a. If symmetrical is TRUE, the axis extends d units in opposite directions. Tick marks, of height ticklen are plotted tickdist units apart.
Plotting of the circle uses get.coords to calculate coordinates along the circumference, and plots the line connecting these with polygon (inspired by #timriffe).
Below we use these functions to replicate the plot provided by the OP.
# Set up plotting device
plot.new()
plot.window(xlim=c(-70, 70), ylim=c(-70, 70), asp=1)
# Plot circle with radius = 60 units and centre at the origin.
polygon(get.coords(seq(0, 360, length.out=1000), 60, 0, 0), lwd=2)
# Plot a polygon with vertices along six axes, at distances of 17, 34, 44, 40,
# 35, and 10 units from the centre.
poly.pts <- get.coords(seq(0, 300, 60), c(17, 34, 44, 40, 35, 10), 0, 0)
polygon(poly.pts$x, poly.pts$y, col='gray', lwd=2)
# Plot the rotated axes
rotatedAxis(0, 0, a=60, d=60, symmetrical=TRUE, tickdist=10, ticklen=1)
rotatedAxis(0, 0, a=120, d=60, symmetrical=TRUE, tickdist=10, ticklen=1)
rotatedAxis(0, 0, a=180, d=60, symmetrical=TRUE, tickdist=10, ticklen=1)
# Add text labels to circumference
text.coords <- get.coords(seq(0, 300, 60), 65, 0, 0)
text(text.coords$x, text.coords$y, c('I', 'A', 'S', 'E', 'C', 'R'))
# Plot a second point and connect to centre by a line
point2 <- get.coords(145, 50, 0, 0)
points(point2, pch=20, cex=2)
segments(0, 0, point2$x, point2$y, lwd=3)
# Plot central point
points(0, 0, pch=21, bg=1, col=0, lwd=2, cex=2)
(Edit: I heavily edited this post - without changing it's general message drastically - in order to make it easier to read and more generally applicable. Additions/changes include that I now define a function to plot rotated axes, plot the circle by calculating coordinates of vertices along the circumference and plotting with polygon, as inspired by #timriffe.)
A solution based on the comment by Thomas and the answer by jbaums.
I used jbaums' method to draw the axes, because I did not want the unbroken circular grid provided by plotrix.
I did not use jbaums' method to draw the circle, because that has a wavy/bumpy line.
I call par(new = TRUE) twice, because the scale in jbaums answer is a tenth of the true scale and I couldn't figure out how to adjust that.
I manually placed the lables, which I'm not happy with.
There's also a lot of superfluous code in there, but I left it in case someone wants to use it to work on their own version.
Here's the code:
# test results
R <- 95
I <- 93
A <- 121
S <- 111
E <- 114
C <- 80
dimensions <- c("R", "I", "A", "S", "E", "C")
values <- c(R, I, A, S, E, C)
RIASEC <- data.frame(
"standard.values" = values,
"RIASEC" = dimensions
)
person.typ <- paste(
head(
RIASEC[
with(
RIASEC,
order(-standard.values)
),
]$RIASEC,
3
),
collapse = ""
)
# length of vector
vi1 <- 0
vi2 <- I
va1 <- 0.8660254 * A
va2 <- 0.5 * A
vs1 <- 0.8660254 * S
vs2 <- -0.5 * S
ve1 <- 0
ve2 <- -E
vc1 <- -0.8660254 * C
vc2 <- -0.5 * C
vr1 <- -0.8660254 * R
vr2 <- 0.5 * R
vek1 <- va1 + vi1 + vr1 + vc1 + ve1 + vs1 # x-axix
vek2 <- vr2 + vi2 + va2 + vs2 + ve2 + vc2 # y-axis
vektor <- sqrt(vek1^2 + vek2^2) # vector length
# angle of vector
if (vek1 == 0) {tg <- 0} else {tg <- vek2 / vek1}
wink <- atan(tg) * 180 / pi
if (vek1 > 0) {
winkel <- 90 - wink
} else if (vek1 == 0) {
if (vek2 >= 0) {winkel <- 360}
else if (vek2 < 0) {winkel <- 180}
} else if (vek1 < 0) {
if (vek2 <= 0) {winkel <- 270 - wink}
else if (vek2 >= 0) {winkel <- 270 - wink}
}
library(plotrix)
axis.angle <- c(0, 60, 120, 180, 240, 300)
axis.rad <- axis.angle * pi / 180
value.length <- values - 70
dev.new(width = 5, height = 5)
radial.plot(value.length, axis.rad, labels = dimensions, start = pi-pi/6, clockwise=TRUE,
rp.type="p", poly.col = "grey", show.grid = TRUE, grid.col = "transparent", radial.lim = c(0,60))
radial.plot.labels(value.length + c(4, 2, -2, 1, 1, 4), axis.rad, radial.lim = c(0,60), start = pi-pi/6, clockwise = TRUE, labels = values, pos = c(1,2,3,1,2,1))
get.coords <- function(a, d, x0=0, y0=0) {
a <- ifelse(a <= 90, 90 - a, 450 - a)
data.frame(x = x0 + d * cos(a / 180 * pi), y = y0+ d * sin(a / 180 * pi) )
}
par(new = TRUE)
plot(NA, xlim = c(-6, 6), ylim=c(-6, 6), type='n', xlab='', ylab='', asp = 1,
axes=FALSE, new = FALSE, bg = "transparent")
circumf.pts <- get.coords(seq(60, 360, 60), 6)
segments(circumf.pts$x[1:3], circumf.pts$y[1:3],
circumf.pts$x[4:6], circumf.pts$y[4:6])
ticks.locs <- lapply(seq(60, 360, 60), get.coords, d=1:6)
ticks <- c(apply(do.call(rbind, ticks.locs[c(1, 4)]), 1, function(x)
get.coords(150, c(-0.1, 0.1), x[1], x[2])),
apply(do.call(rbind, ticks.locs[c(2, 5)]), 1, function(x)
get.coords(30, c(-0.1, 0.1), x[1], x[2])),
apply(do.call(rbind, ticks.locs[c(3, 6)]), 1, function(x)
get.coords(90, c(-0.1, 0.1), x[1], x[2])))
lapply(ticks, function(x) segments(x$x[1], x$y[1], x$x[2], x$y[2]))
par(new = TRUE)
plot(NA, xlim = c(-60, 60), ylim=c(-60, 60), type='n', xlab='', ylab='', asp = 1,
axes=FALSE, new = FALSE, bg = "transparent")
segments(0, 0, vek1, vek2, lwd=3)
points(vek1, vek2, pch=20, cex=2)
symbols(c(0, 0, 0), c(0, 0, 0), circles = c(60, 2, 1.3), inches = FALSE, add = TRUE, fg = c("black", "white", "black"), bg = c("transparent", "white", "black"))
And here's the graphic:

Resources