Displaying minor logarithmic ticks in x-axis in R - r

I have a normal distribution plot and a histogram plot with x axis in log scale displaying 0, 10^0, 10^1 ... I want to include minor ticks between the major ones. Actually I was able to change the major ticks format from 1, 2, 3 and so on to 10^0, 10^1, 10^2, 10^3 using the solution given to me in my previous question. I used the following code for the major ticks :
major.ticks <- axTicks(1)
labels <- sapply(major.ticks,function(i)
as.expression(bquote(10^ .(i)))
)
axis(1,at=major.ticks,labels=labels)
Can this be edited to just mark the minor ticks without labeling them?

There is a function minor.tick in the package Hmisc, but that one deals poorly with logarithmical scales. I use the following function for getting minor ticks that follow the logarithmical scale. ax is the axis you use it on (same as for the function axis), n is the number of minor ticks (default to 9), t.ratio is the ratio between the major and the minor ticks, and with ... you can pass extra parameters to axis
edit : Nice idea in the comments, so I edited my function. There are two extra parameters, mn and mx for the minimum and the maximum on the logarithmic scale (mn=0 thus means the minimum is 10^0 or 1 !)
The function:
minor.ticks.axis <- function(ax,n,t.ratio=0.5,mn,mx,...){
lims <- par("usr")
if(ax %in%c(1,3)) lims <- lims[1:2] else lims[3:4]
major.ticks <- pretty(lims,n=5)
if(missing(mn)) mn <- min(major.ticks)
if(missing(mx)) mx <- max(major.ticks)
major.ticks <- major.ticks[major.ticks >= mn & major.ticks <= mx]
labels <- sapply(major.ticks,function(i)
as.expression(bquote(10^ .(i)))
)
axis(ax,at=major.ticks,labels=labels,...)
n <- n+2
minors <- log10(pretty(10^major.ticks[1:2],n))-major.ticks[1]
minors <- minors[-c(1,n)]
minor.ticks = c(outer(minors,major.ticks,`+`))
minor.ticks <- minor.ticks[minor.ticks > mn & minor.ticks < mx]
axis(ax,at=minor.ticks,tcl=par("tcl")*t.ratio,labels=FALSE)
}
This can be applied as follows :
x <- 10^(0:8)
y <- 1:9
plot(log10(x),y,xaxt="n",xlab="x",xlim=c(0,9))
minor.ticks.axis(1,9,mn=0,mx=8)
Gives :

Here is a simple function to to this:
log10.axis <- function(side, at, ...) {
at.minor <- log10(outer(1:9, 10^(min(at):max(at))))
lab <- sapply(at, function(i) as.expression(bquote(10^ .(i))))
axis(side=side, at=at.minor, labels=NA, tcl=par("tcl")*0.5, ...)
axis(side=side, at=at, labels=lab, ...)
}
Here is an example:
x <- exp(rnorm(200, 5))
hist(log(x), 20, xaxt="n", xlim=c(0, 8))
log10.axis(1, at=seq(0, 8, 2))
Gives:

Try magaxis in package magicaxis.

In ggplot2, we can use annotation_logticks together with scales::trans_breaks and scales::trans_format. Below is an example taken from the link above.
library(ggplot2)
a <- ggplot(msleep, aes(bodywt, brainwt)) +
geom_point(na.rm = TRUE) +
scale_x_log10(
breaks = scales::trans_breaks("log10", function(x) 10^x),
labels = scales::trans_format("log10", scales::math_format(10^.x))
) +
scale_y_log10(
breaks = scales::trans_breaks("log10", function(x) 10^x),
labels = scales::trans_format("log10", scales::math_format(10^.x))
) +
theme_bw()
a + annotation_logticks() # Default: log ticks on bottom and left

There is the minorAxis function in the StratigrapheR package, that can be used for any kind of minor ticks. It can be used with the seq_log function to make logarithmic ticks:
library(StratigrapheR)
x <- exp(rnorm(200, 5))
hist(log10(x), 20, xaxt="n", xlim=c(0, 4), xlab = "x", main = "Logarithmic Histogram of x")
ticks <- seq_log(10^0,10^4, divide = T)
lab <- sapply(0:4, function(i) as.expression(bquote(10^ .(i))))
minorAxis(1, at.maj = log10(ticks[[1]]), at.min = log10(ticks[[2]]), labels = lab)
Gives:

Use "" for the labels of the minor ticks.

There was a small error,
lims<-lims[3:4] was missing
minor.ticks.axis <- function(ax,n,t.ratio=0.5,mn,mx,...){
lims <- par("usr")
if(ax %in%c(1,3)) lims <- lims[1:2] else lims <- lims[3:4]
major.ticks <- pretty(lims,n=5)
if(missing(mn)) mn <- min(major.ticks)
if(missing(mx)) mx <- max(major.ticks)
major.ticks <- major.ticks[major.ticks >= mn & major.ticks <= mx]
labels <- sapply(major.ticks,function(i)
as.expression(bquote(10^ .(i)))
)
axis(ax,at=major.ticks,labels=labels,...)
n <- n+2
minors <- log10(pretty(10^major.ticks[1:2],n))-major.ticks[1]
minors <- minors[-c(1,n)]
minor.ticks = c(outer(minors,major.ticks,`+`))
minor.ticks <- minor.ticks[minor.ticks > mn & minor.ticks < mx]
axis(ax,at=minor.ticks,tcl=par("tcl")*t.ratio,labels=FALSE)
}

The x axis labels in the first plot on this page is in error.
The minor ticks are not properly distributed.

Related

Using base R, how to create a "joy plot" (aka ridgeline plots), with many distributions on top of each other with vertical offset?

The type of plot I am trying to achieve in R seems to have been known as either as moving distribution, as joy plot or as ridgeline plot:
There is already a question in Stackoverflow whose recorded answer explains how to do it using ggplot: How to reproduce this moving distribution plot with R?
However, for learning purposes, I am trying to achieve the same using only base R plots (no lattice, no ggplot, no any plotting package).
In order to get started, I generated the following fake data to play with:
set.seed(2020)
shapes <- c(0.1, 0.5, 1, 2, 4, 5, 6)
dat <- lapply(shapes, function(x) rbeta(1000, x, x))
names(dat) <- letters[1:length(shapes)]
Then using mfrow I can achieve this:
par(mfrow=c(length(shapes), 1))
par(mar=c(1, 5, 1, 1))
for(i in 1:length(shapes))
{
values <- density(dat[[names(dat)[i]]])
plot(NA,
xlim=c(min(values$x), max(values$x)),
ylim=c(min(values$y), max(values$y)),
axes=FALSE,
main="",
xlab="",
ylab=letters[i])
polygon(values, col="light blue")
}
The result I get is:
Clearly, using mfrow (or even layout) here is not flexible enough and also does allow for the overlaps between the distributions.
Then, the question: how can I reproduce that type of plot using only base R plotting functions?
Here's a base R solution. First, we calculate all the density values and then manually offset off the y axis
vals <- Map(function(x, g, i) {
with(density(x), data.frame(x,y=y+(i-1), g))
}, dat, names(dat), seq_along(dat))
Then, to plot, we calculate the overall range, draw an empty plot, and the draw the densities (in reverse so they stack)
xrange <- range(unlist(lapply(vals, function(d) range(d$x))))
yrange <- range(unlist(lapply(vals, function(d) range(d$y))))
plot(0,0, type="n", xlim=xrange, ylim=yrange, yaxt="n", ylab="", xlab="Value")
for(d in rev(vals)) {
with(d, polygon(x, y, col="light blue"))
}
axis(2, at=seq_along(dat)-1, names(dat))
d = lapply(dat, function(x){
tmp = density(x)
data.frame(x = tmp$x, y = tmp$y)
})
d = lapply(seq_along(d), function(i){
tmp = d[[i]]
tmp$grp = names(d)[i]
tmp
})
d = do.call(rbind, d)
grp = unique(d$grp)
n = length(grp)
spcx = 5
spcy = 3
rx = range(d$x)
ry = range(d$y)
rx[2] = rx[2] + n/spcx
ry[2] = ry[2] + n/spcy
graphics.off()
plot(1, type = "n", xlim = rx, ylim = ry, axes = FALSE, ann = FALSE)
lapply(seq_along(grp), function(i){
x = grp[i]
abline(h = (n - i)/spcy, col = "grey")
axis(2, at = (n - i)/spcy, labels = grp[i])
polygon(d$x[d$grp == x] + (n - i)/spcx,
d$y[d$grp == x] + (n - i)/spcy,
col = rgb(0.5, 0.5, 0.5, 0.5))
})

Overlay many plots with a different range of x

I would like to make a plot like the this image what I want, however I don't know how. I wrote the code below but I don't find a way to obtain the plot. The point here is to add density lines to my original plot (Relation Masa-SFR) the density is supposed to be every 0.3 in x. I mean one line from 7 to 7.3, the next one from 7.3 to 7.6 and so on. With the code below (continue until x=12), I obtain the this [plot][2]
plot(SFsl$MEDMASS, SFR_SalpToMPA,xlim= range(7:12),
ylim= range(-3:2.5),ylab="log(SFR(M(sun)/yr)",
xlab="log(M(star)/(M(sun)")
title("Relacion Masa-SFR")
par(new=TRUE)
FCUTsfrsl1=(SFsl$MEDMASS >= 7 & SFsl$MEDMASS <=7.3 &
SFR_SalpToMPA < 2 & SFR_SalpToMPA > -3)
x <- SFR_SalpToMPA[FCUTsfrsl1]
y <- density(x)
plot(y$y, y$x, type='l',ylim=range(-3:2.5), col="red",
ylab="", xlab="", axes=FALSE)
I did what you said but I obtained this plot, I don't know if I did something wrong
Since I don't have your data, I had to make some up. If this does what you want, I think you can adapt it to your actual data.
set.seed(7)
x <- runif(1000, 7, 12)
y <- runif(1000, -3, 3)
DF <- data.frame(x = x, y = y)
plot(DF$x, DF$y)
# Cut the x axis into 0.3 unit segments, compute the density and plot
br <- seq(7, 12, 0.333)
intx <- cut(x, br) # intervals
intx2 <- as.factor(cut(x, br, labels = FALSE)) # intervals by code
intx3 <- split(x, intx) # x values
inty <- split(y, intx2) # corresponding y values for density calc
for (i in 1:length(intx3)) {
xx <- seq(min(intx3[[i]]), max(intx3[[i]]), length.out = 512)
lines(xx, density(inty[[i]])$y, col = "red")
}
This produce the following image. You need to look closely but there is a separate density plot for each 0.3 unit interval.
EDIT Change the dimension that is used to compute the density
set.seed(7)
x <- runif(1000, 7, 12)
y <- runif(1000, -3, 3)
DF <- data.frame(x = x, y = y)
plot(DF$x, DF$y, xlim = c(7, 15))
# Cut the x axis into 0.3 unit segments, compute the density and plot
br <- seq(7, 12, 0.333)
intx <- cut(x, br) # intervals
intx2 <- as.factor(cut(x, br, labels = FALSE)) # intervals by code
intx3 <- split(x, intx) # x values
inty <- split(y, intx2) # corresponding y values
# This gives the density values in the horizontal direction (desired)
# This is the change, the above is unchanged.
for (i in 1:length(intx3)) {
yy <- seq(min(inty[[i]]), max(inty[[i]]), length.out = 512)
offset <- min(intx3[[i]])
lines(density(intx3[[i]])$y + offset, yy, col = "red")
}
Which gives:

Facet_wrap like plot using R base graphics

I want to compare two datasets with same x and y variables. However, not all X variable points are present on both. As a toy example say this is what I have:
position.x <- c(1,2,3)
score.x <- c(450,220,330)
x <- data.frame(position,score.x)
position.y <- c(2,3,5)
score.y <- c(333,423,988)
y<- data.frame(position.y,score.y)
par(mfrow = c(2,1))
plot(x, pch = 19)
plot(y, pch = 19)
X axes are not comparable. I found some post explaining how to do it on ggplot using facet_wrap but I would like to do it using base graph.
Thank you in advance.
you could specify the range of the x and y axises by xlim and slim
position.x <- c(1,2,3)
score.x <- c(450,220,330)
x <- data.frame(position,score.x)
position.y <- c(2,3,5)
score.y <- c(333,423,988)
y<- data.frame(position.y,score.y)
par(mfrow = c(2,1))
plot(x, pch = 19, xlim=c(1,5))
plot(y, pch = 19, xlim=c(1,5))
if you are going to repeat this, you might as well write some kind of function (which is one of the benefits of ggplot--it takes care of all the set-up for you):
## data needs to be in a long format
dat <- data.frame(position = c(1,2,3,2,3,5),
score = c(450,220,330,333,423,988),
z = c('x','x','x','y','y','y'))
facet_wrap <- function(data, x, y, z, horiz = TRUE, ...) {
## save current par settings and return after finished
op <- par(no.readonly = TRUE)
on.exit(par(op))
zz <- unique(data[, z])
## sets up the layout to cascade horizontally or vertically
## and sets xlim and ylim appropriately
if (horiz) {
par(mfrow = c(1, length(zz)), ...)
ylim <- range(data[, y])
xlim <- NULL
} else {
par(mfrow = c(length(zz), 1), ...)
xlim <- range(data[, x])
ylim <- NULL
}
## make a subset of data for each unique by variable
## and draw a basic plot for each one
for (ii in zz) {
tmp <- data[data[, z] %in% ii, ]
plot(tmp[, x], tmp[, y], xlim = xlim, ylim = ylim)
}
}
facet_wrap(dat, 'position', 'score', 'z', mar = c(5,4,2,2))
facet_wrap(dat, 'position', 'score', 'z', mar = c(5,4,1,2), horiz = FALSE)

How to invert the y-axis on a plot

I would like to know how to make a plot in R where the y-axis is inverted such that the plotted data appears in what would be the fourth quadrant (IV) of a cartesian plane, as opposed to the first (I) quadrant.
For reference, the plot I am trying to make looks very similar to the following (source):
I have found a number of questions online pertaining to reversing the numbering on the y-axis, but these all still plot the data in the first quadrant. Can anyone suggest how I might produce a plot similar to that shown above?
Just to provide a worked out answer, following the comments of #timriffe and #joran...
Use the function for minor log ticks from this answer:
minor.ticks.axis <- function(ax,n,t.ratio=0.5,mn,mx,...){
lims <- par("usr")
if(ax %in%c(1,3)) lims <- lims[1:2] else lims[3:4]
major.ticks <- pretty(lims,n=5)
if(missing(mn)) mn <- min(major.ticks)
if(missing(mx)) mx <- max(major.ticks)
major.ticks <- major.ticks[major.ticks >= mn & major.ticks <= mx]
labels <- sapply(major.ticks,function(i)
as.expression(bquote(10^ .(i)))
)
axis(ax,at=major.ticks,labels=labels,...)
n <- n+2
minors <- log10(pretty(10^major.ticks[1:2],n))-major.ticks[1]
minors <- minors[-c(1,n)]
minor.ticks = c(outer(minors,major.ticks,`+`))
minor.ticks <- minor.ticks[minor.ticks > mn & minor.ticks < mx]
axis(ax,at=minor.ticks,tcl=par("tcl")*t.ratio,labels=FALSE)
}
Make some reproducible example data:
x <- 1:8
y <- 10^(sort(runif(8, 1, 10), decreasing = TRUE))
Plot without axes:
plot(x, log10(y), # function to plot
xlab="", # suppress x labels
type = 'l', # specify line graph
xlim = c(min(x), (max(x)*1.3)), # extend axis limits to give space for text annotation
ylim = c(0, max(log10(y))), # ditto
axes = FALSE) # suppress both axes
Add fancy log axis and turn tick labels right way up (thanks #joran!):
minor.ticks.axis(2, 9, mn=0, mx=10, las=1)
Add x-axis up the top:
axis(3)
Add x-axis label (thanks for the tip, #WojciechSobala)
mtext("x", side = 3, line = 2)
And add an annotation to the end of the line
text(max(x), min(log10(y)), "Example", pos = 1)
Here's the result:
Answering the question in the title, the best/easiest way to invert the axis is to flip the limit variables around:
> plot(1:10, xlim=c(1,10));
> plot(1:10, xlim=c(10,1));
> plot(1:10, ylim=c(10,1));
Doing it this way means that you don't need to mess around with axes that are different from the image coordinates.
This can be combined with the 'xaxt="n"' parameter and an additional axis command to place an axis on another side:
> plot(1:10, ylim=c(10,1), xaxt="n"); axis(3);
It's now quite easy to reverse the y-axis using scale_y_reverse and specify position = "top" for the x-axis in ggplot2
Example
library(ggplot2)
library(scales)
set.seed(99)
Date <- seq(from = as.Date("2017-12-01"), to = as.Date("2017-12-15"),
by = "days")
Flux <- runif(length(Date), 1, 10000)
Flux_df <- data.frame(Date, Flux)
p1 <- ggplot(Flux_df, aes(Date, Flux)) +
geom_col() +
xlab("") +
scale_x_date(position = "top", breaks = pretty_breaks(), expand = c(0, 0)) +
scale_y_reverse(expand = expand_scale(mult = c(0.2, 0))) +
theme_bw(base_size = 16) +
theme(panel.border = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line()) +
theme(legend.position = "none")
p1
If we want both logarithmic and reverse axis, we need a workaround suggested here as ggplot2 does not have that option atm
reverselog_trans <- function(base = exp(1)) {
trans <- function(x) -log(x, base)
inv <- function(x) base^(-x)
scales::trans_new(paste0("reverselog-", format(base)), trans, inv,
scales::log_breaks(base = base), domain = c(1e-100, Inf))
}
p1 + scale_y_continuous(trans = reverselog_trans(10),
breaks = scales::trans_breaks("log10", function(x) 10^x),
labels = scales::trans_format("log10", scales::math_format(10^.x)),
expand = expand_scale(mult = c(0.2, 0))) +
annotation_logticks()

Color code a scatterplot based on another value - no ggplot

I have to plot some plot(x,y) scatters, but i would like the points to be color coded based on the value of a continuous variable z.
I would like a temperature palette (from dark blue to bright red). I tried with Rcolorbrewer however the the RdBu palette (which resembles the temperature palette) uses white for the middle values which looks very bad.
I would also like to plot a legend explaining the color coding with a sample of colors and corresponding values.
Any ideas if this can be performed easily in R? No ggplot please!
Season greetings to everybody
Building off of #BenBolker's answer, you can do the legend if you take a peek at the code for filled.contour. I hacked that function apart to look like this:
scatter.fill <- function (x, y, z,
nlevels = 20, plot.title, plot.axes,
key.title, key.axes, asp = NA, xaxs = "i",
yaxs = "i", las = 1,
axes = TRUE, frame.plot = axes, ...)
{
mar.orig <- (par.orig <- par(c("mar", "las", "mfrow")))$mar
on.exit(par(par.orig))
w <- (3 + mar.orig[2L]) * par("csi") * 2.54
layout(matrix(c(2, 1), ncol = 2L), widths = c(1, lcm(w)))
par(las = las)
mar <- mar.orig
mar[4L] <- mar[2L]
mar[2L] <- 1
par(mar = mar)
#Some simplified level/color picking
levels <- seq(min(z),max(z),length.out = nlevels)
col <- colorRampPalette(c("blue","red"))(nlevels)[rank(z)]
plot.new()
plot.window(xlim = c(0, 1), ylim = range(levels), xaxs = "i",
yaxs = "i")
rect(0, levels[-length(levels)], 1, levels[-1L], col = colorRampPalette(c("blue","red"))(nlevels)
if (missing(key.axes)) {
if (axes)
axis(4)
}
else key.axes
box()
if (!missing(key.title))
key.title
mar <- mar.orig
mar[4L] <- 1
par(mar = mar)
#Simplified scatter plot construction
plot(x,y,type = "n")
points(x,y,col = col,...)
if (missing(plot.axes)) {
if (axes) {
title(main = "", xlab = "", ylab = "")
Axis(x, side = 1)
Axis(y, side = 2)
}
}
else plot.axes
if (frame.plot)
box()
if (missing(plot.title))
title(...)
else plot.title
invisible()
}
And then applying the code from Ben's example we get this:
x <- runif(40)
y <- runif(40)
z <- runif(40)
scatter.fill(x,y,z,nlevels = 40,pch = 20)
which produces a plot like this:
Fair warning, I really did just hack apart the code for filled.contour. You will likely want to inspect the remaining code and remove unused bits, or fix parts that I rendered non-functional.
Here some home-made code to achieve it with default packages (base, graphics, grDevices) :
# Some data
x <- 1:1000
y <- rnorm(1000)
z <- 1:1000
# colorRamp produces custom palettes, but needs values between 0 and 1
colorFunction <- colorRamp(c("darkblue", "black", "red"))
zScaled <- (z - min(z)) / (max(z) - min(z))
# Apply colorRamp and switch to hexadecimal representation
zMatrix <- colorFunction(zScaled)
zColors <- rgb(zMatrix, maxColorValue=255)
# Let's plot
plot(x=x, y=y, col=zColors, pch="+")
For StanLe, here is the corresponding legend (to be added by layout or something similar) :
# Resolution of the legend
n <- 10
# colorRampPalette produces colors in the same way than colorRamp
plot(x=NA, y=NA, xlim=c(0,n), ylim=0:1, xaxt="n", yaxt="n", xlab="z", ylab="")
pal <- colorRampPalette(c("darkblue", "black", "red"))(n)
rect(xleft=0:(n-1), xright=1:n, ybottom=0, ytop=1, col=pal)
# Custom axis ticks (consider pretty() for an automated generation)
lab <- c(1, 500, 1000)
at <- (lab - min(z)) / (max(z) - min(z)) * n
axis(side=1, at=at, labels=lab)
This is a reasonable solution -- I used blue rather than dark blue for the starting point, but you can check out ?rgb etc. to adjust the color to your liking.
nbrk <- 30
x <- runif(20)
y <- runif(20)
cc <- colorRampPalette(c("blue","red"))(nbrk)
z <- runif(20)
plot(x,y,col=cc[cut(z,nbrk)],pch=16)

Resources